aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Universal-Turing-machine/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Universal_Turing_machine

83
Task/Universal-Turing-machine/00-TASK.txt Normal file
View file

@ -0,0 +1,83 @@
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
is [[wp:Turing_completeness|turing-complete]]
is to implement a universal Turing machine in it.
;Task:
Simulate such a machine capable
of taking the definition of any other Turing machine and executing it.
Of course, you will not have an infinite tape,
but you should emulate this as much as is possible.
The three permissible actions on the tape are "left", "right" and "stay".
To test your universal Turing machine (and prove your programming language
is Turing complete!), you should execute the following two Turing machines
based on the following definitions.
'''Simple incrementer'''
* '''States:''' q0, qf
* '''Initial state:''' q0
* '''Terminating states:''' qf
* '''Permissible symbols:''' B, 1
* '''Blank symbol:''' B
* '''Rules:'''
** (q0, 1, 1, right, q0)
** (q0, B, 1, stay, qf)
<br>
The input for this machine should be a tape of <code>1 1 1</code>
'''Three-state busy beaver'''
* '''States:''' a, b, c, halt
* '''Initial state:''' a
* '''Terminating states:''' halt
* '''Permissible symbols:''' 0, 1
* '''Blank symbol:''' 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)
<br>
The input for this machine should be an empty tape.
'''Bonus:'''
'''5-state, 2-symbol probable Busy Beaver machine from Wikipedia'''
* '''States:''' A, B, C, D, E, H
* '''Initial state:''' A
* '''Terminating states:''' H
* '''Permissible symbols:''' 0, 1
* '''Blank symbol:''' 0
* '''Rules:'''
** (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)
<br>
The input for this machine should be an empty tape.
This machine runs for more than 47 millions steps.
<br><br>

82
Task/Universal-Turing-machine/11l/universal-turing-machine.11l Normal file
View file

@ -0,0 +1,82 @@
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)
)

77
Task/Universal-Turing-machine/APL/universal-turing-machine-1.apl Normal file
View file

@ -0,0 +1,77 @@
: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

24
Task/Universal-Turing-machine/APL/universal-turing-machine-2.apl Normal file
View file

@ -0,0 +1,24 @@
∆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
∇

54
Task/Universal-Turing-machine/Ada/universal-turing-machine-1.ada Normal file
View file

@ -0,0 +1,54 @@
private with Ada.Containers.Doubly_Linked_Lists;
generic
type State is (<>); -- State'First is starting state
type Symbol is (<>); -- Symbol'First is blank
package Turing is
Start: constant State := State'First;
Halt: constant State := State'Last;
subtype Action_State is State range Start .. State'Pred(Halt);
Blank: constant Symbol := Symbol'First;
type Movement is (Left, Stay, Right);
type Action is record
New_State: State;
Move_To: Movement;
New_Symbol: Symbol;
end record;
type Rules_Type is array(Action_State, Symbol) of Action;
type Tape_Type is limited private;
type Symbol_Map is array(Symbol) of Character;
function To_String(Tape: Tape_Type; Map: Symbol_Map) return String;
function Position_To_String(Tape: Tape_Type; Marker: Character := '^')
return String;
function To_Tape(Str: String; Map: Symbol_Map) return Tape_Type;
procedure Single_Step(Current: in out State;
Tape: in out Tape_Type;
Rules: Rules_Type);
procedure Run(The_Tape: in out Tape_Type;
Rules: Rules_Type;
Max_Steps: Natural := Natural'Last;
Print: access procedure(Tape: Tape_Type; Current: State));
-- runs from Start State until either Halt or # Steps exceeds Max_Steps
-- if # of steps exceeds Max_Steps, Constrained_Error is raised;
-- if Print is not null, Print is called at the beginning of each step
private
package Symbol_Lists is new Ada.Containers.Doubly_Linked_Lists(Symbol);
subtype List is Symbol_Lists.List;
type Tape_Type is record
Left: List;
Here: Symbol;
Right: List;
end record;
end Turing;

98
Task/Universal-Turing-machine/Ada/universal-turing-machine-2.ada Normal file
View file

@ -0,0 +1,98 @@
package body Turing is
function List_To_String(L: List; Map: Symbol_Map) return String is
LL: List := L;
use type List;
begin
if L = Symbol_Lists.Empty_List then
return "";
else
LL.Delete_First;
return Map(L.First_Element) & List_To_String(LL, Map);
end if;
end List_To_String;
function To_String(Tape: Tape_Type; Map: Symbol_Map) return String is
begin
return List_To_String(Tape.Left, Map) & Map(Tape.Here) &
List_To_String(Tape.Right, Map);
end To_String;
function Position_To_String(Tape: Tape_Type; Marker: Character := '^')
return String is
Blank_Map: Symbol_Map := (others => ' ');
begin
return List_To_String(Tape.Left, Blank_Map) & Marker &
List_To_String(Tape.Right, Blank_Map);
end Position_To_String;
function To_Tape(Str: String; Map: Symbol_Map) return Tape_Type is
Char_Map: array(Character) of Symbol := (others => Blank);
Tape: Tape_Type;
begin
if Str = "" then
Tape.Here := Blank;
else
for S in Symbol loop
Char_Map(Map(S)) := S;
end loop;
Tape.Here := Char_Map(Str(Str'First));
for I in Str'First+1 .. Str'Last loop
Tape.Right.Append(Char_Map(Str(I)));
end loop;
end if;
return Tape;
end To_Tape;
procedure Single_Step(Current: in out State;
Tape: in out Tape_Type;
Rules: Rules_Type) is
Act: Action := Rules(Current, Tape.Here);
use type List; -- needed to compare Tape.Left/Right to the Empty_List
begin
Current := Act.New_State; -- 1. update State
Tape.Here := Act.New_Symbol; -- 2. write Symbol to Tape
case Act.Move_To is -- 3. move Tape to the Left/Right or Stay
when Left =>
Tape.Right.Prepend(Tape.Here);
if Tape.Left /= Symbol_Lists.Empty_List then
Tape.Here := Tape.Left.Last_Element;
Tape.Left.Delete_Last;
else
Tape.Here := Blank;
end if;
when Stay =>
null; -- Stay where you are!
when Right =>
Tape.Left.Append(Tape.Here);
if Tape.Right /= Symbol_Lists.Empty_List then
Tape.Here := Tape.Right.First_Element;
Tape.Right.Delete_First;
else
Tape.Here := Blank;
end if;
end case;
end Single_Step;
procedure Run(The_Tape: in out Tape_Type;
Rules: Rules_Type;
Max_Steps: Natural := Natural'Last;
Print: access procedure (Tape: Tape_Type; Current: State)) is
The_State: State := Start;
Steps: Natural := 0;
begin
Steps := 0;
while (Steps <= Max_Steps) and (The_State /= Halt) loop
if Print /= null then
Print(The_Tape, The_State);
end if;
Steps := Steps + 1;
Single_Step(The_State, The_Tape, Rules);
end loop;
if The_State /= Halt then
raise Constraint_Error;
end if;
end Run;
end Turing;

27
Task/Universal-Turing-machine/Ada/universal-turing-machine-3.ada Normal file
View file

@ -0,0 +1,27 @@
with Ada.Text_IO, Turing;
procedure Simple_Incrementer is
type States is (Start, Stop);
type Symbols is (Blank, One);
package UTM is new Turing(States, Symbols);
use UTM;
Map: Symbol_Map := (One => '1', Blank => '_');
Rules: Rules_Type :=
(Start => (One => (Start, Right, One),
Blank => (Stop, Stay, One)));
Tape: Tape_Type := To_Tape("111", Map);
procedure Put_Tape(Tape: Tape_Type; Current: States) is
begin
Ada.Text_IO.Put_Line(To_String(Tape, Map) & " " & States'Image(Current));
Ada.Text_IO.Put_Line(Position_To_String(Tape));
end Put_Tape;
begin
Run(Tape, Rules, 20, null); -- don't print the configuration during running
Put_Tape(Tape, Stop); -- print the final configuration
end Simple_Incrementer;

31
Task/Universal-Turing-machine/Ada/universal-turing-machine-4.ada Normal file
View file

@ -0,0 +1,31 @@
with Ada.Text_IO, Turing;
procedure Busy_Beaver_3 is
type States is (A, B, C, Stop);
type Symbols is range 0 .. 1;
package UTM is new Turing(States, Symbols); use UTM;
Map: Symbol_Map := (1 => '1', 0 => '0');
Rules: Rules_Type :=
(A => (0 => (New_State => B, Move_To => Right, New_Symbol => 1),
1 => (New_State => C, Move_To => Left, New_Symbol => 1)),
B => (0 => (New_State => A, Move_To => Left, New_Symbol => 1),
1 => (New_State => B, Move_To => Right, New_Symbol => 1)),
C => (0 => (New_State => B, Move_To => Left, New_Symbol => 1),
1 => (New_State => Stop, Move_To => Stay, New_Symbol => 1)));
Tape: Tape_Type := To_Tape("", Map);
procedure Put_Tape(Tape: Tape_Type; Current: States) is
begin
Ada.Text_IO.Put_Line(To_String(Tape, Map) & " " &
States'Image(Current));
Ada.Text_IO.Put_Line(Position_To_String(Tape));
end Put_Tape;
begin
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;

89
Task/Universal-Turing-machine/Amazing-Hopper/universal-turing-machine.hopper Normal file
View file

@ -0,0 +1,89 @@
#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

174
Task/Universal-Turing-machine/AutoHotkey/universal-turing-machine.ahk Normal file
View file

@ -0,0 +1,174 @@
; By Uberi, http://www.autohotkey.com/board/topic/58599-turing-machine/
SetBatchLines, -1
OnExit, Exit
SaveFilePath := A_ScriptFullPath ".ini"
; Defaults are for a 2-state_3-symbol turning machine. Format:
; machine state symbol on tape, symbol on tape | tape shift (- is left, + is right, 0 is halt) | machine state
, Rule1 := "A0,1|1|B"
, Rule2 := "A1,2|-1|A"
, Rule3 := "A2,1|-1|A"
, Rule4 := "B0,2|-1|A"
, Rule5 := "B1,2|1|B"
, Rule6 := "B2,0|1|A"
; no error check is run on this input, so be sure states and symbols align with actions
IniRead, UseSaveFile, %SaveFilePath%, Global, UseSaveFile, 1 ; on exit, save state to text file so I can resume on next run
IniRead, MaxIterations, %SaveFilePath%, Global, MaxIterations, 100000 ; set as %A_Space% to run indefinitely
IniRead, Section, %SaveFilePath%, Global, Section, 2-state_3-symbol ; The name of the machine to run. Options defined:
; 2-state_3-symbol
; Simple_incrementer
; Three-state_busy_beaver
; Probable_busy_beaver_Wikipedia
IniRead, States, %SaveFilePath%, %Section%, States, A|B ; valid states
IniRead, InitialState, %SaveFilePath%, %Section%, InitialState, A ; start state
IniRead, TerminalState, %SaveFilePath%, %Section%, TerminalState, C ; end state
IniRead, Symbols, %SaveFilePath%, %Section%, Symbols, 0,1,2 ; valid symbols
IniRead, DefaultCell, %SaveFilePath%, %Section%, DefaultCell, 0 ; the default symbol of any cell not defined on input tape
IniRead, ProgramCode, %SaveFilePath%, %Section%, ProgramCode, 10101|01010 ; start tape
Iniread, RuleCount, %SaveFilePath%, %Section%, RuleCount, 6 ; number of actions to read
Loop, %RuleCount%
{
IniRead, Temp1, %SaveFilePath%, %Section%, Rule%A_Index%, % Rule%A_Index%
StringSplit, Temp, Temp1, `,
Action%Temp1% := Temp2
}
IniRead, Index, %SaveFilePath%, SavedState, Index, 0
IniRead, IterationCount, %SaveFilePath%, SavedState, IterationCount, 0
IniRead, State, %SaveFilePath%, SavedState, State, %InitialState%
If IterationCount > 0
IniRead, ProgramCode, %SaveFilePath%, SavedState, ProgramCode, %ProgramCode%
IfNotInString, ProgramCode, |
ProgramCode := "|" ProgramCode
StringSplit, Temp, ProgramCode, |
NegativeCells := Temp1, PositiveCells := Temp2
Loop, Parse, Symbols, |
Color%A_LoopField% := hex(mod((A_Index+1/(2**((A_Index-1)//7))-1)/7,1)*16777215) ; unlimited number of unique colors
Color%DefaultCell% := "White"
Gui, Color, Black
Gui, +ToolWindow +AlwaysOnTop +LastFound -Caption
WindowID := WinExist()
OnMessage(0x201, "WM_LBUTTONDOWN")
Gui, Font, s6 cWhite, Arial
Loop, 61 ; display 30 cell symbols on each side of current index
{
Temp1 := ((A_Index - 1) * 15) + 1
Gui, Add, Progress, x%Temp1% y1 w14 h40 vCell%A_Index% BackgroundWhite
Gui, Add, Text, x%Temp1% y42 w15 h10 vLabel%A_Index% Center
}
Gui, Add, Text, x2 y54 w26 h10 vState
Gui, Add, Text, x35 y54 w50 h10 vCurrentCell
Gui, Add, Text, x350 y54 w158 h10 vActions
Gui, Add, Text, x844 y54 w33 h10, Iterations:
Gui, Add, Text, x884 y54 w29 h10 vIterations Right
Gui, Font, s4 cWhite Bold, Arial
Gui, Add, Text, x450 y1 w15 h10 Center, V
GuiControl, Move, Cell31, x451 y8 w14 h33
Gui, Show, y20 w916 h64, Wolfram's 2-State 3-Symbol Turing Machine ;'
;MaxIndex := ProgramOffset + StrLen(ProgramCode), MinIndex := ProgramOffset ; not implemented
While, ((MaxIterations = "") || IterationCount <= MaxIterations) ; process until limit is reached, if any
{
Loop, 61 ; color each cell per its current symbol
{ ; must run for all displayed cells because they are not directly mapped to shifting tape
TempIndex := (Index + A_Index) - 31
GuiControl, , Label%A_Index%, %TempIndex%
CellColor := CellGet(TempIndex)
, CellColor := Color%CellColor%
GuiControl, +Background%CellColor%, Cell%A_Index%
}
CurrentCell := CellGet(Index)
GuiControl, , State, State: %State%
GuiControl, , CurrentCell, Current Cell: %CurrentCell%
GuiControl, , Iterations, %IterationCount%
If (State = TerminalState)
Break
StringSplit, Temp, Action%State%%CurrentCell%, |
GuiControl, , Actions, % "Actions: Print " . Temp1 . ", Move " . ((Temp2 = -1) ? "left" : "right") . ", " . ((State <> Temp3) ? "Switch to state " . Temp3 : "Do not switch state")
IterationCount++
, CellPut(Index,Temp1)
, Index += Temp2
, State := Temp3
;, (Index > MaxIndex) ? MaxIndex := Index : ""
;, (Index < MinIndex) ? MinIndex := Index : ""
Sleep, 0.1*1000
}
MsgBox, 64, Complete, Completed %IterationCount% iterations of the Turing machine.
Return
; Hotkeys and functions:
~Pause::Pause
GuiEscape:
GuiClose:
ExitApp
Exit:
If UseSaveFile
{
IniWrite, %Index%, %SaveFilePath%, %Section%, Index
IniWrite, %IterationCount%, %SaveFilePath%, %Section%, IterationCount
IniWrite, %State%, %SaveFilePath%, %Section%, State
IniWrite, %NegativeCells%|%PositiveCells%, %SaveFilePath%, %Section%, ProgramCode
}
ExitApp
CellGet(Index)
{
global NegativeCells, PositiveCells, DefaultCell
Temp1 := (Index < 0) ? SubStr(NegativeCells,Abs(Index),1) : SubStr(PositiveCells,Index + 1,1)
Return, (Temp1 = "") ? DefaultCell : Temp1
}
CellPut(Index,Char)
{
global NegativeCells, PositiveCells, DefaultCell
static StrGetFunc := "StrGet" ; workaround to hide function from AHK Basic (which does not have or require it)
CharType := A_IsUnicode ? "UShort" : "UChar"
, (Index < 0)
? (Index := 0 - Index
, Temp1 := Index - StrLen(NegativeCells)
, (Temp1 > 0)
? (VarSetCapacity(Pad,64) ; these three functions are quirks in AHK's memory management (not required)
, VarSetCapacity(Pad,0)
, VarSetCapacity(Pad,Temp1,Asc(DefaultCell))
, NegativeCells .= A_IsUnicode ? %StrGetFunc%(&Pad,Temp1,"CP0") : Pad)
: ""
, NumPut(Asc(Char),NegativeCells,(Index - 1) << !!A_IsUnicode,CharType) )
: (Temp1 := Index - StrLen(PositiveCells) + 1
, (Temp1 > 0)
? (VarSetCapacity(Pad,64) ; these three functions are quirks in AHK's memory management (not required)
, VarSetCapacity(Pad,0)
, VarSetCapacity(Pad,Temp1,Asc(DefaultCell))
, PositiveCells .= A_IsUnicode ? %StrGetFunc%(&Pad,Temp1,"CP0") : Pad)
: ""
, NumPut(Asc(Char),PositiveCells,Index << !!A_IsUnicode,CharType) )
}
Hex(p_Integer)
{
PtrType:=(A_PtrSize=8) ? "Ptr":"UInt"
l_Format:="`%0" . 6 . "I64X"
VarSetCapacity(l_Argument,8)
NumPut(p_Integer,l_Argument,0,"Int64")
VarSetCapacity(l_Buffer,A_IsUnicode ? 12:6,0)
DllCall(A_IsUnicode ? "msvcrt\_vsnwprintf":"msvcrt\_vsnprintf"
,"Str",l_Buffer ;-- Storage location for output
,"UInt",6 ;-- Maximum number of characters to write
,"Str",l_Format ;-- Format specification
,PtrType,&l_Argument) ;-- Argument
Return l_Buffer
}
WM_LBUTTONDOWN()
{
If (A_Gui = 1)
PostMessage, 0xA1, 2
}

134
Task/Universal-Turing-machine/C++/universal-turing-machine.cpp Normal file
View file

@ -0,0 +1,134 @@
#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; }
//--------------------------------------------------------------------------------------------------

200
Task/Universal-Turing-machine/C-sharp/universal-turing-machine.cs Normal file
View file

@ -0,0 +1,200 @@
using System;
using System.Collections.Generic;
using System.Diagnostics;
using System.Linq;
using System.Text;
using System.Threading;
using System.Threading.Tasks;
public class TuringMachine
{
public static async Task Main() {
var fiveStateBusyBeaver = new TuringMachine("A", '0', "H").WithTransitions(
("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")
);
var busyBeaverTask = fiveStateBusyBeaver.TimeAsync();
var incrementer = new TuringMachine("q0", 'B', "qf").WithTransitions(
("q0", '1', '1', Right, "q0"),
("q0", 'B', '1', Stay, "qf")
)
.WithInput("111");
foreach (var _ in incrementer.Run()) PrintLine(incrementer);
PrintResults(incrementer);
var threeStateBusyBeaver = new TuringMachine("a", '0', "halt").WithTransitions(
("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")
);
foreach (var _ in threeStateBusyBeaver.Run()) PrintLine(threeStateBusyBeaver);
PrintResults(threeStateBusyBeaver);
var sorter = new TuringMachine("A", '*', "X").WithTransitions(
("A", 'a', 'a', Right, "A"),
("A", 'b', 'B', Right, "B"),
("A", '*', '*', Left, "E"),
("B", 'a', 'a', Right, "B"),
("B", 'b', 'b', Right, "B"),
("B", '*', '*', Left, "C"),
("C", 'a', 'b', Left, "D"),
("C", 'b', 'b', Left, "C"),
("C", 'B', 'b', Left, "E"),
("D", 'a', 'a', Left, "D"),
("D", 'b', 'b', Left, "D"),
("D", 'B', 'a', Right, "A"),
("E", 'a', 'a', Left, "E"),
("E", '*', '*', Right, "X")
)
.WithInput("babbababaa");
sorter.Run().Last();
Console.WriteLine("Sorted: " + sorter.TapeString);
PrintResults(sorter);
sorter.Reset().WithInput("bbbababaaabba");
sorter.Run().Last();
Console.WriteLine("Sorted: " + sorter.TapeString);
PrintResults(sorter);
Console.WriteLine(await busyBeaverTask);
PrintResults(fiveStateBusyBeaver);
void PrintLine(TuringMachine tm) => Console.WriteLine(tm.TapeString + "\tState " + tm.State);
void PrintResults(TuringMachine tm) {
Console.WriteLine($"End state: {tm.State} = {(tm.Success ? "Success" : "Failure")}");
Console.WriteLine(tm.Steps + " steps");
Console.WriteLine("tape length: " + tm.TapeLength);
Console.WriteLine();
}
}
public const int Left = -1, Stay = 0, Right = 1;
private readonly Tape tape;
private readonly string initialState;
private readonly HashSet<string> terminatingStates;
private Dictionary<(string state, char read), (char write, int move, string toState)> transitions;
public TuringMachine(string initialState, char blankSymbol, params string[] terminatingStates) {
State = this.initialState = initialState;
tape = new Tape(blankSymbol);
this.terminatingStates = terminatingStates.ToHashSet();
}
public TuringMachine WithTransitions(
params (string state, char read, char write, int move, string toState)[] transitions)
{
this.transitions = transitions.ToDictionary(k => (k.state, k.read), k => (k.write, k.move, k.toState));
return this;
}
public TuringMachine Reset() {
State = initialState;
Steps = 0;
tape.Reset();
return this;
}
public TuringMachine WithInput(string input) {
tape.Input(input);
return this;
}
public int Steps { get; private set; }
public string State { get; private set; }
public bool Success => terminatingStates.Contains(State);
public int TapeLength => tape.Length;
public string TapeString => tape.ToString();
public IEnumerable<string> Run() {
yield return State;
while (Step()) yield return State;
}
public async Task<TimeSpan> TimeAsync(CancellationToken cancel = default) {
var chrono = Stopwatch.StartNew();
await RunAsync(cancel);
chrono.Stop();
return chrono.Elapsed;
}
public Task RunAsync(CancellationToken cancel = default)
=> Task.Run(() => {
while (Step()) cancel.ThrowIfCancellationRequested();
});
private bool Step() {
if (!transitions.TryGetValue((State, tape.Current), out var action)) return false;
tape.Current = action.write;
tape.Move(action.move);
State = action.toState;
Steps++;
return true;
}
private class Tape
{
private List<char> forwardTape = new List<char>(), backwardTape = new List<char>();
private int head = 0;
private char blank;
public Tape(char blankSymbol) => forwardTape.Add(blank = blankSymbol);
public void Reset() {
backwardTape.Clear();
forwardTape.Clear();
head = 0;
forwardTape.Add(blank);
}
public void Input(string input) {
Reset();
forwardTape.Clear();
forwardTape.AddRange(input);
}
public void Move(int direction) {
head += direction;
if (head >= 0 && forwardTape.Count <= head) forwardTape.Add(blank);
if (head < 0 && backwardTape.Count <= ~head) backwardTape.Add(blank);
}
public char Current {
get => head < 0 ? backwardTape[~head] : forwardTape[head];
set {
if (head < 0) backwardTape[~head] = value;
else forwardTape[head] = value;
}
}
public int Length => backwardTape.Count + forwardTape.Count;
public override string ToString() {
int h = (head < 0 ? ~head : backwardTape.Count + head) * 2 + 1;
var builder = new StringBuilder(" ", Length * 2 + 1);
if (backwardTape.Count > 0) {
builder.Append(string.Join(" ", backwardTape)).Append(" ");
if (head < 0) (builder[h + 1], builder[h - 1]) = ('(', ')');
for (int l = 0, r = builder.Length - 1; l < r; l++, r--) (builder[l], builder[r]) = (builder[r], builder[l]);
}
builder.Append(string.Join(" ", forwardTape)).Append(" ");
if (head >= 0) (builder[h - 1], builder[h + 1]) = ('(', ')');
return builder.ToString();
}
}
}

231
Task/Universal-Turing-machine/C/universal-turing-machine.c Normal file
View file

@ -0,0 +1,231 @@
#include <stdio.h>
#include <stdarg.h>
#include <stdlib.h>
#include <string.h>
enum {
LEFT,
RIGHT,
STAY
};
typedef struct {
int state1;
int symbol1;
int symbol2;
int dir;
int state2;
} transition_t;
typedef struct tape_t tape_t;
struct tape_t {
int symbol;
tape_t *left;
tape_t *right;
};
typedef struct {
int states_len;
char **states;
int final_states_len;
int *final_states;
int symbols_len;
char *symbols;
int blank;
int state;
int tape_len;
tape_t *tape;
int transitions_len;
transition_t ***transitions;
} turing_t;
int state_index (turing_t *t, char *state) {
int i;
for (i = 0; i < t->states_len; i++) {
if (!strcmp(t->states[i], state)) {
return i;
}
}
return 0;
}
int symbol_index (turing_t *t, char symbol) {
int i;
for (i = 0; i < t->symbols_len; i++) {
if (t->symbols[i] == symbol) {
return i;
}
}
return 0;
}
void move (turing_t *t, int dir) {
tape_t *orig = t->tape;
if (dir == RIGHT) {
if (orig && orig->right) {
t->tape = orig->right;
}
else {
t->tape = calloc(1, sizeof (tape_t));
t->tape->symbol = t->blank;
if (orig) {
t->tape->left = orig;
orig->right = t->tape;
}
}
}
else if (dir == LEFT) {
if (orig && orig->left) {
t->tape = orig->left;
}
else {
t->tape = calloc(1, sizeof (tape_t));
t->tape->symbol = t->blank;
if (orig) {
t->tape->right = orig;
orig->left = t->tape;
}
}
}
}
turing_t *create (int states_len, ...) {
va_list args;
va_start(args, states_len);
turing_t *t = malloc(sizeof (turing_t));
t->states_len = states_len;
t->states = malloc(states_len * sizeof (char *));
int i;
for (i = 0; i < states_len; i++) {
t->states[i] = va_arg(args, char *);
}
t->final_states_len = va_arg(args, int);
t->final_states = malloc(t->final_states_len * sizeof (int));
for (i = 0; i < t->final_states_len; i++) {
t->final_states[i] = state_index(t, va_arg(args, char *));
}
t->symbols_len = va_arg(args, int);
t->symbols = malloc(t->symbols_len);
for (i = 0; i < t->symbols_len; i++) {
t->symbols[i] = va_arg(args, int);
}
t->blank = symbol_index(t, va_arg(args, int));
t->state = state_index(t, va_arg(args, char *));
t->tape_len = va_arg(args, int);
t->tape = NULL;
for (i = 0; i < t->tape_len; i++) {
move(t, RIGHT);
t->tape->symbol = symbol_index(t, va_arg(args, int));
}
if (!t->tape_len) {
move(t, RIGHT);
}
while (t->tape->left) {
t->tape = t->tape->left;
}
t->transitions_len = va_arg(args, int);
t->transitions = malloc(t->states_len * sizeof (transition_t **));
for (i = 0; i < t->states_len; i++) {
t->transitions[i] = malloc(t->symbols_len * sizeof (transition_t *));
}
for (i = 0; i < t->transitions_len; i++) {
transition_t *tran = malloc(sizeof (transition_t));
tran->state1 = state_index(t, va_arg(args, char *));
tran->symbol1 = symbol_index(t, va_arg(args, int));
tran->symbol2 = symbol_index(t, va_arg(args, int));
tran->dir = va_arg(args, int);
tran->state2 = state_index(t, va_arg(args, char *));
t->transitions[tran->state1][tran->symbol1] = tran;
}
va_end(args);
return t;
}
void print_state (turing_t *t) {
printf("%-10s ", t->states[t->state]);
tape_t *tape = t->tape;
while (tape->left) {
tape = tape->left;
}
while (tape) {
if (tape == t->tape) {
printf("[%c]", t->symbols[tape->symbol]);
}
else {
printf(" %c ", t->symbols[tape->symbol]);
}
tape = tape->right;
}
printf("\n");
}
void run (turing_t *t) {
int i;
while (1) {
print_state(t);
for (i = 0; i < t->final_states_len; i++) {
if (t->final_states[i] == t->state) {
return;
}
}
transition_t *tran = t->transitions[t->state][t->tape->symbol];
t->tape->symbol = tran->symbol2;
move(t, tran->dir);
t->state = tran->state2;
}
}
int main () {
printf("Simple incrementer\n");
turing_t *t = create(
/* states */ 2, "q0", "qf",
/* final_states */ 1, "qf",
/* symbols */ 2, 'B', '1',
/* blank */ 'B',
/* initial_state */ "q0",
/* initial_tape */ 3, '1', '1', '1',
/* transitions */ 2,
"q0", '1', '1', RIGHT, "q0",
"q0", 'B', '1', STAY, "qf"
);
run(t);
printf("\nThree-state busy beaver\n");
t = create(
/* states */ 4, "a", "b", "c", "halt",
/* final_states */ 1, "halt",
/* symbols */ 2, '0', '1',
/* blank */ '0',
/* initial_state */ "a",
/* initial_tape */ 0,
/* transitions */ 6,
"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"
);
run(t);
return 0;
printf("\nFive-state two-symbol probable busy beaver\n");
t = create(
/* states */ 6, "A", "B", "C", "D", "E", "H",
/* final_states */ 1, "H",
/* symbols */ 2, '0', '1',
/* blank */ '0',
/* initial_state */ "A",
/* initial_tape */ 0,
/* transitions */ 10,
"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"
);
run(t);
}

257
Task/Universal-Turing-machine/CLU/universal-turing-machine.clu Normal file
View file

@ -0,0 +1,257 @@
% 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

26
Task/Universal-Turing-machine/Clojure/universal-turing-machine-1.clj Normal file
View file

@ -0,0 +1,26 @@
(defn tape
"Creates a new tape with given blank character and tape contents"
([blank] (tape () blank () blank))
([right blank] (tape () (first right) (rest right) blank))
([left head right blank] [(reverse left) (or head blank) (into () right) blank]))
; Tape operations
(defn- left [[[l & ls] _ rs b] c] [ls (or l b) (conj rs c) b])
(defn- right [[ls _ [r & rs] b] c] [(conj ls c) (or r b) rs b])
(defn- stay [[ls _ rs b] c] [ls c rs b])
(defn- head [[_ c _ b]] (or c b))
(defn- pretty [[ls c rs b]] (concat (reverse ls) [[(or c b)]] rs))
(defn new-machine
"Returns a function that takes a tape as input, and returns the tape
after running the machine specified in `machine`."
[machine]
(let [rules (into {} (for [[s c c' a s'] (:rules machine)]
[[s c] [c' (-> a name symbol resolve) s']]))
finished? (into #{} (:terminating machine))]
(fn [input-tape]
(loop [state (:initial machine) tape input-tape]
(if (finished? state)
(pretty tape)
(let [[out action new-state] (get rules [state (head tape)])]
(recur new-state (action tape out))))))))

40
Task/Universal-Turing-machine/Clojure/universal-turing-machine-2.clj Normal file
View file

@ -0,0 +1,40 @@
(def simple-incrementer
(new-machine {:initial :q0
:terminating [:qf]
:rules [[:q0 1 1 :right :q0]
[:q0 \B 1 :stay :qf]]}))
(deftest simple-incrementer-test
(is (= [1 1 1 [1]] (simple-incrementer (tape [1 1 1] \B)))))
(def three-state-two-symbol-busy-beaver
(new-machine {:initial :a
:terminating [:halt]
: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]]}))
(deftest three-state-two-symbol-busy-beaver-test
(is (= [1 1 1 [1] 1 1] (three-state-two-symbol-busy-beaver (tape 0)))))
(def five-state-two-symbol-busy-beaver
(new-machine {:initial :A
:terminating [:H]
:rules [[: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]]}))
(deftest five-state-two-symbol-busy-beaver-test
(let [result (flatten (five-state-two-symbol-busy-beaver (tape 0)))
freq (frequencies result)]
(is (= 4098 (get freq 1)))
(is (= 8191 (get freq 0)))))

35
Task/Universal-Turing-machine/Common-Lisp/universal-turing-machine-1.lisp Normal file
View file

@ -0,0 +1,35 @@
(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))))))

37
Task/Universal-Turing-machine/Common-Lisp/universal-turing-machine-2.lisp Normal file
View file

@ -0,0 +1,37 @@
(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)))

55
Task/Universal-Turing-machine/Common-Lisp/universal-turing-machine-3.lisp Normal file
View file

@ -0,0 +1,55 @@
;; 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))

300
Task/Universal-Turing-machine/Cowgol/universal-turing-machine.cowgol Normal file
View file

@ -0,0 +1,300 @@
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;

236
Task/Universal-Turing-machine/D/universal-turing-machine-1.d Normal file
View file

@ -0,0 +1,236 @@
import std.stdio, std.algorithm, std.string, std.conv, std.array,
std.exception, std.traits, std.math, std.range;
struct UTM(State, Symbol, bool doShow=true)
if (is(State == enum) && is(Symbol == enum)) {
static assert(is(typeof({ size_t x = State.init; })),
"State must to be usable as array index.");
static assert([EnumMembers!State].equal(EnumMembers!State.length.iota),
"State must be a plain enum.");
static assert(is(typeof({ size_t x = Symbol.init; })),
"Symbol must to be usable as array index.");
static assert([EnumMembers!Symbol].equal(EnumMembers!Symbol.length.iota),
"Symbol must be a plain enum.");
enum Direction { right, left, stay }
private const TuringMachine tm;
private TapeHead head;
alias SymbolMap = string[EnumMembers!Symbol.length];
// The first index of this 'rules' matrix is a subtype of State
// because it can't contain H, but currently D can't enforce this,
// statically unlike Ada language.
Rule[EnumMembers!Symbol.length][EnumMembers!State.length - 1] mRules;
static struct Rule {
Symbol toWrite;
Direction direction;
State nextState;
this(in Symbol toWrite_, in Direction direction_, in State nextState_)
pure nothrow @safe @nogc {
this.toWrite = toWrite_;
this.direction = direction_;
this.nextState = nextState_;
}
}
// This is kept separated from the rest so it can be inialized
// one field at a time in the main function, yet it will become
// const.
static struct TuringMachine {
Symbol blank;
State initialState;
Rule[Symbol][State] rules;
Symbol[] input;
SymbolMap symbolMap;
}
static struct TapeHead {
immutable Symbol blank;
Symbol[] tapeLeft, tapeRight;
int position;
const SymbolMap sMap;
size_t nSteps;
this(in ref TuringMachine t) pure nothrow @safe {
this.blank = EnumMembers!Symbol[0];
//tapeRight = t.input.empty ? [this.blank] : t.input.dup;
if (t.input.empty)
this.tapeRight = [this.blank];
else
this.tapeRight = t.input.dup;
this.position = 0;
this.sMap = t.symbolMap;
}
pure nothrow @safe @nogc invariant {
assert(this.tapeRight.length > 0);
if (this.position >= 0)
assert(this.position < this.tapeRight.length);
else
assert(this.position.abs <= this.tapeLeft.length);
}
Symbol readSymb() const pure nothrow @safe @nogc {
if (this.position >= 0)
return this.tapeRight[this.position];
else
return this.tapeLeft[this.position.abs - 1];
}
void showSymb() const @safe {
this.write;
}
void writeSymb(in Symbol symbol) @safe {
static if (doShow)
showSymb;
if (this.position >= 0)
this.tapeRight[this.position] = symbol;
else
this.tapeLeft[this.position.abs - 1] = symbol;
}
void goRight() pure nothrow @safe {
this.position++;
if (position > 0 && position == tapeRight.length)
tapeRight ~= blank;
}
void goLeft() pure nothrow @safe {
this.position--;
if (position < 0 && (position.abs - 1) == tapeLeft.length)
tapeLeft ~= blank;
}
void move(in Direction dir) pure nothrow @safe {
nSteps++;
final switch (dir) with (Direction) {
case left: goLeft; break;
case right: goRight; break;
case stay: /*Do nothing*/ break;
}
}
string toString() const @safe {
immutable pos = tapeLeft.length.signed + this.position + 4;
return format("...%-(%)...", tapeLeft.retro.chain(tapeRight)
.map!(s => sMap[s])) ~
'\n' ~
format("%" ~ pos.text ~ "s", "^") ~
'\n';
}
}
void show() const @safe {
head.showSymb;
}
this(in ref TuringMachine tm_) @safe {
static assert(__traits(compiles, State.H), "State needs a 'H' (Halt).");
immutable errMsg = "Invalid input.";
auto runningStates = remove!(s => s == State.H)([EnumMembers!State]);
enforce(!runningStates.empty, errMsg);
enforce(tm_.rules.length == EnumMembers!State.length - 1, errMsg);
enforce(State.H !in tm_.rules, errMsg);
enforce(runningStates.canFind(tm_.initialState), errMsg);
// Create a matrix to reduce running time.
foreach (immutable State st, const rset; tm_.rules)
foreach (immutable Symbol sy, immutable rule; rset)
mRules[st][sy] = rule;
this.tm = tm_;
head = TapeHead(this.tm);
State state = tm.initialState;
while (state != State.H) {
immutable next = mRules[state][head.readSymb];
head.writeSymb(next.toWrite);
head.move(next.direction);
state = next.nextState;
}
static if (doShow)
show;
writeln("Performed ", head.nSteps, " steps.");
}
}
void main() @safe {
"Incrementer:".writeln;
enum States1 : ubyte { A, H }
enum Symbols1 : ubyte { s0, s1 }
alias M1 = UTM!(States1, Symbols1);
M1.TuringMachine tm1;
with (tm1) with (States1) with (Symbols1) with (M1.Direction) {
alias R = M1.Rule;
initialState = A;
rules = [A: [s0: R(s1, stay, H), s1: R(s1, right, A)]];
input = [s1, s1, s1];
symbolMap = ["0", "1"];
}
M1(tm1);
// http://en.wikipedia.org/wiki/Busy_beaver
"\nBusy Beaver machine (3-state, 2-symbol):".writeln;
enum States2 : ubyte { A, B, C, H }
alias Symbols2 = Symbols1;
alias M2 = UTM!(States2, Symbols2);
M2.TuringMachine tm2;
with (tm2) with (States2) with (Symbols2) with (M2.Direction) {
alias R = M2.Rule;
initialState = A;
rules = [A: [s0: R(s1, right, B), s1: R(s1, left, C)],
B: [s0: R(s1, left, A), s1: R(s1, right, B)],
C: [s0: R(s1, left, B), s1: R(s1, stay, H)]];
symbolMap = ["0", "1"];
}
M2(tm2);
"\nSorting stress test (12212212121212):".writeln;
enum States3 : ubyte { A, B, C, D, E, H }
enum Symbols3 : ubyte { s0, s1, s2, s3 }
alias M3 = UTM!(States3, Symbols3, false);
M3.TuringMachine tm3;
with (tm3) with (States3) with (Symbols3) with (M3.Direction) {
alias R = M3.Rule;
initialState = A;
rules = [A: [s1: R(s1, right, A),
s2: R(s3, right, B),
s0: R(s0, left, E)],
B: [s1: R(s1, right, B),
s2: R(s2, right, B),
s0: R(s0, left, C)],
C: [s1: R(s2, left, D),
s2: R(s2, left, C),
s3: R(s2, left, E)],
D: [s1: R(s1, left, D),
s2: R(s2, left, D),
s3: R(s1, right, A)],
E: [s1: R(s1, left, E),
s0: R(s0, stay, H)]];
input = [s1, s2, s2, s1, s2, s2, s1,
s2, s1, s2, s1, s2, s1, s2];
symbolMap = ["0", "1", "2", "3"];
}
M3(tm3).show;
"\nPossible best Busy Beaver machine (5-state, 2-symbol):".writeln;
alias States4 = States3;
alias Symbols4 = Symbols1;
alias M4 = UTM!(States4, Symbols4, false);
M4.TuringMachine tm4;
with (tm4) with (States4) with (Symbols4) with (M4.Direction) {
alias R = M4.Rule;
initialState = A;
rules = [A: [s0: R(s1, right, B), s1: R(s1, left, C)],
B: [s0: R(s1, right, C), s1: R(s1, right, B)],
C: [s0: R(s1, right, D), s1: R(s0, left, E)],
D: [s0: R(s1, left, A), s1: R(s1, left, D)],
E: [s0: R(s1, stay, H), s1: R(s0, left, A)]];
symbolMap = ["0", "1"];
}
M4(tm4);
}

18
Task/Universal-Turing-machine/D/universal-turing-machine-2.d Normal file
View file

@ -0,0 +1,18 @@
import std.stdio, std.typecons, std.algorithm, std.string, std.array;
void turing(Sy, St)(in St state, Sy[int] tape, in int pos,
in Tuple!(Sy, int, St)[Sy][St] rules) {
if (state.empty) return;
const r = rules[state][tape[pos] = tape.get(pos, Sy.init)];
writefln("%-(%s%)", tape.keys.sort()
.map!(i => format(i == pos ? "(%s)" : " %s ", tape[i])));
tape[pos] = r[0];
turing(r[2], tape, pos + r[1], rules);
}
void main() {
turing("a", null, 0,
["a": [0: tuple(1, 1, "b"), 1: tuple(1, -1, "c")],
"b": [0: tuple(1, -1, "a"), 1: tuple(1, 1, "b")],
"c": [0: tuple(1, -1, "b"), 1: tuple(1, 0, "")]]);
}

290
Task/Universal-Turing-machine/EDSAC-order-code/universal-turing-machine.edsac Normal file
View file

@ -0,0 +1,290 @@
[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]

101
Task/Universal-Turing-machine/EchoLisp/universal-turing-machine-1.l Normal file
View file

@ -0,0 +1,101 @@
(require 'struct)
(struct TM (read-only: name states symbs final rules mem state-values: tape pos state))
(define-syntax-rule (rule-idx state symb numstates)
(+ state (* symb numstates)))
(define-syntax-rule (make-TM name states symbs rules)
(_make-TM name 'states 'symbs 'rules))
;; a rule is (state symbol --> write move new-state)
;; index for rule = state-num + (number of states) * symbol-num
;; convert states/symbol into vector indices
(define (compile-rule T rule into: rules)
(define numstates (vector-length (TM-states T)))
(define state (vector-index [rule 0](TM-states T) )) ; index
(define symb (vector-index [rule 1](TM-symbs T) ))
(define write-symb (vector-index [rule 2] (TM-symbs T) ))
(define move (1- (vector-index [rule 3] #(left stay right) )))
(define new-state (vector-index [rule 4](TM-states T)))
(define rulenum (rule-idx state symb numstates))
(vector-set! rules rulenum (vector write-symb move new-state))
; (writeln 'rule rulenum [rules rulenum])
)
(define (_make-TM name states symbs rules)
(define T (TM name (list->vector states) (list->vector symbs) null null))
(set-TM-final! T (1- (length states))) ;; assume one final state
(set-TM-rules! T (make-vector (* (length states) (length symbs))))
(for ((rule rules)) (compile-rule T (list->vector rule) into: (TM-rules T)))
T ) ; returns a TM
;;------------------
;; TM-trace
;;-------------------
(string-delimiter "")
(define (TM-print T symb-index: symb (hilite #f))
(cond
((= 0 symb) (if hilite "🔲" "◽️" ))
((= 1 symb) (if hilite "🔳 " "◾️" ))
(else "X")))
(define (TM-trace T tape pos state step)
(if (= (TM-final T) state)
(write "🔴")
(write "🔵"))
(for [(p (in-range (- (TM-mem T) 7) (+ (TM-mem T) 8)))]
(write (TM-print T [tape p] (= p pos))))
(write step)
(writeln))
;;---------------
;; TM-init : alloc and init tape
;;---------------
(define (TM-init T input-symbs (mem 20))
;; init state variables
(set-TM-tape! T (make-vector (* 2 mem)))
(set-TM-pos! T mem)
(set-TM-state! T 0)
(set-TM-mem! T mem)
(for [(symb input-symbs) (i (in-naturals))]
(vector-set! (TM-tape T) [+ i (TM-pos T)] (vector-index symb (TM-symbs T))))
(TM-trace T (TM-tape T) mem 0 0)
mem )
;;---------------
;; TM-run : run at most maxsteps
;;---------------
(define (TM-run T (verbose #f) (maxsteps 1_000_000))
(define count 0)
(define final (TM-final T))
(define rules (TM-rules T))
(define rule 0)
(define numstates (vector-length (TM-states T)))
;; set current state vars
(define pos (TM-pos T))
(define state (TM-state T))
(define tape (TM-tape T))
(when (and (zero? state) (= pos (TM-mem T)))
(writeln 'Starting (TM-name T))
(TM-trace T tape pos 0 count))
(while (and (!= state final) (< count maxsteps))
(++ count)
;; The machine
(set! rule [rules (rule-idx state [tape pos] numstates)])
(when (= rule 0) (error "missing rule" (list state [tape pos])))
(vector-set! tape pos [rule 0])
(set! state [rule 2])
(+= pos [rule 1])
;; end machine
(when verbose (TM-trace T tape pos state count )))
;; save TM state
(set-TM-pos! T pos)
(set-TM-state! T state)
(when (= final state) (writeln 'Stopping (TM-name T) 'at-pos (- pos (TM-mem T))))
count)

8
Task/Universal-Turing-machine/EchoLisp/universal-turing-machine-2.l Normal file
View file

@ -0,0 +1,8 @@
(define steps 0)
(define (TM-task T)
(define count (TM-run T #f 1000000))
(when (zero? steps) (writeln 'START (date)))
(+= steps count)
(writeln 'TM-steps steps (date))
(when (zero? count) (writeln 'END steps (date)))
(if (zero? count) #f T)) ;; return #f to signal end of task

68
Task/Universal-Turing-machine/Erlang/universal-turing-machine.erl Normal file
View file

@ -0,0 +1,68 @@
#!/usr/bin/env escript
-module(turing).
-mode(compile).
-export([main/1]).
% Incrementer definition:
% States: a | halt
% Initial state: a
% Halting states: halt
% Symbols: b | '1'
% Blank symbol: b
incrementer_config() -> {a, [halt], b}.
incrementer(a, '1') -> {'1', right, a};
incrementer(a, b) -> {'1', stay, halt}.
% Busy beaver definition:
% States: a | b | c | halt
% Initial state: a
% Halting states: halt
% Symbols: '0' | '1'
% Blank symbol: '0'
busy_beaver_config() -> {a, [halt], '0'}.
busy_beaver(a, '0') -> {'1', right, b};
busy_beaver(a, '1') -> {'1', left, c};
busy_beaver(b, '0') -> {'1', left, a};
busy_beaver(b, '1') -> {'1', right, b};
busy_beaver(c, '0') -> {'1', left, b};
busy_beaver(c, '1') -> {'1', stay, halt}.
% Mainline code.
main([]) ->
io:format("==============================~n"),
io:format("Turing machine simulator test.~n"),
io:format("==============================~n"),
Tape1 = turing(fun incrementer_config/0, fun incrementer/2, ['1','1','1']),
io:format("~w~n", [Tape1]),
Tape2 = turing(fun busy_beaver_config/0, fun busy_beaver/2, []),
io:format("~w~n", [Tape2]).
% Universal Turing machine simulator.
turing(Config, Rules, Input) ->
{Start, _, _} = Config(),
{Left, Right} = perform(Config, Rules, Start, {[], Input}),
lists:reverse(Left) ++ Right.
perform(Config, Rules, State, Input = {LeftInput, RightInput}) ->
{_, Halts, Blank} = Config(),
case lists:member(State, Halts) of
true -> Input;
false ->
{NewRight, Symbol} = symbol(RightInput, Blank),
{NewSymbol, Action, NewState} = Rules(State, Symbol),
NewInput = action(Action, Blank, {LeftInput, [NewSymbol| NewRight]}),
perform(Config, Rules, NewState, NewInput)
end.
symbol([], Blank) -> {[], Blank};
symbol([S|R], _) -> {R, S}.
action(left, Blank, {[], Right}) -> {[], [Blank|Right]};
action(left, _, {[L|Ls], Right}) -> {Ls, [L|Right]};
action(stay, _, Tape) -> Tape;
action(right, Blank, {Left, []}) -> {[Blank|Left], []};
action(right, _, {Left, [R|Rs]}) -> {[R|Left], Rs}.

5
Task/Universal-Turing-machine/Fortran/universal-turing-machine-1.f Normal file
View file

@ -0,0 +1,5 @@
200 I = STATE*NSYMBOL - ICHAR(TAPE(HEAD)) !Index the transition.
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...

188
Task/Universal-Turing-machine/Fortran/universal-turing-machine-2.f Normal file
View file

@ -0,0 +1,188 @@
PROGRAM U !Reads a specification of a Turing machine, and executes it.
Careful! Reserves a symbol #0 to represent blank tape as a blank.
INTEGER MANY,FIRST,LAST !Some sizes must be decided upon.
PARAMETER (MANY = 66, FIRST = 1, LAST = 666) !These should do.
INTEGER HERE(MANY)
CHARACTER*1 MARK(MANY) !The transition table.
INTEGER*1 MOVE(MANY) !Three related arrays.
CHARACTER*1 NEXT(MANY) !All with the same indexing.
CHARACTER*1 TAPE(FIRST:LAST)!Notionally, no final bound, in both directions - a potential infinity..
INTEGER STATE !Execution starts with state 1.
INTEGER HEAD !And the tape read/write head at position 1.
INTEGER STEP !And we might as well keep count.
INTEGER OFFSET !An affine shift.
INTEGER NSTATE !Counts can be helpful.
INTEGER NSYMBOL !The count of recognised symbols.
INTEGER S,S1 !Symbol numbers.
CHARACTER*1 RS,WS !Input scanning: read symbol, write symbol.
CHARACTER*1 SYMBOL(0:MANY) !I reserve SYMBOL(0).
CHARACTER*(MANY) SYMBOLS !Up to 255, for single character variables.
EQUIVALENCE (SYMBOL(1),SYMBOLS) !Individually or collectively.
INTEGER I,J,K,L,IT !Assistants.
INTEGER LONG !Now for some text scanning.
PARAMETER (LONG = 80) !This should suffice.
CHARACTER*(LONG) ALINE !A scratchpad.
REAL T0,T1 !Some CPU time attempts.
INTEGER KBD,MSG,INF !Some I/O unit numbers.
KBD = 5 !Standard input.
MSG = 6 !Standard output
INF = 10 !Suitable for a disc file.
OPEN (INF,FILE = "TestAdd1.dat",ACTION="READ") !Go for one.
READ (INF,1) ALINE !The first line is to be a heding.
1 FORMAT (A) !Just plain text.
WRITE (MSG,2) ALINE !Reveal it.
2 FORMAT ("Turing machine simulation for... ",A) !Announce the plan.
READ (INF,*) SYMBOLS !Allows a quoted string.
NSYMBOL = LEN_TRIM(SYMBOLS) !How many symbols? (Trailing spaces will be lost)
WRITE (MSG,3) NSYMBOL,SYMBOLS(1:NSYMBOL) !They will be symbol number 0, 1, ..., NSYMBOL - 1.
3 FORMAT (I0," symbols: >",A,"<") !And this is their count.
IF (NSYMBOL.LE.1) STOP "Expect at least two symbols!"
SYMBOL(0) = " " !My special state meaning "never before seen".
NSYMBOL = NSYMBOL + 1 !So, one more is in actual use.
NSTATE = 0 !As for states, I haven't seen any.
MOVE = -66 !This should cause trouble and be noticed!
MARK = CHAR(0) !In case a state is omitted.
NEXT = CHAR(0) !Like, mention state seven, but omit mention of state six.
HERE = 0 !Clear the counts.
Collate the transition table.
10 READ (INF,*) STATE !Read this once, rather than for every transition.
IF (STATE.LE.0) GO TO 20 !Ah, finished.
WRITE (MSG,11) STATE !But they can come in any order.
NSTATE = MAX(STATE,NSTATE)!And I'd like to know how many.
11 FORMAT ("Entry: Read Write Move Next. For state ",I0) !Prepare a nice heading.
IF (STATE.LE.0) STOP "Positive STATE numbers only!" !It may not be followed.
IF (STATE*NSYMBOL.GT.MANY) STOP"My transition table is too small!" !But the value of STATE is shown.
DO S = 0,NSYMBOL - 1 !Initialise the transitions for STATE.
IT = STATE*NSYMBOL - S !Finger the one for S.
MARK(IT) = CHAR(S) !No change to what's under the head.
NEXT(IT) = CHAR(0) !And this stops the run.
END DO !Just in case a symbol's number is omitted.
DO S = 1,NSYMBOL - 1 !A transition for every symbol must be given or the read process will get out of step.
READ(INF,*) RS,WS,K,L !Read symbol, write symbol, move, next.
I = INDEX(SYMBOLS(1:NSYMBOL - 1),RS) !Convert the character to a symbol number.
J = INDEX(SYMBOLS(1:NSYMBOL - 1),WS) !To enable decorative glyphs, not just digits.
IF (I.LE.0) STOP "Unrecognised read symbol!" !This really should be more helpful.
IF (J.LE.0) STOP "Unrecognised write symbol!" !By reading into ALINE and showing it, etc.
IT = STATE*NSYMBOL - I !Locate the entry for the state x symbol pair.
MARK(IT) = CHAR(J) !The value to be written.
MOVE(IT) = K !The movement of the tape head.
NEXT(IT) = CHAR(L) !The next state.
IF (I.EQ.1) S1 = IT !This transition will be duplicated. SYMBOL(1) is for blank tape.
END DO !On to the next symbol's transition.
Copy SYMBOL(1)'s transition to the transition for the secret extra, SYMBOL(0).
IT = STATE*NSYMBOL !Finger the interpolated entry for SYMBOL(0).
MARK(IT) = MARK(S1) !Thus will SYMBOL(0), shown as a space, be overwritten.
MOVE(IT) = MOVE(S1) !And SYMBOL(0) treated
NEXT(IT) = NEXT(S1) !Exactly as if it were SYMBOL(1).
Cast forth the transition table for STATE, not mentioning SYMBOL(0) - but see label 911.
DO S = 1,NSYMBOL - 1 !Roll them out in the order as given in SYMBOL.
IT = STATE*NSYMBOL - S !But the entry number will be odd.
WRITE (ALINE,12) IT,SYMBOL(S), !The character's code value is irrelevant.
1 SYMBOL(ICHAR(MARK(IT))),MOVE(IT),ICHAR(NEXT(IT)) !Append the details just read.
12 FORMAT (I5,":",2X,'"',A1,'"',3X'"',A1,'"',I5,I5,I13) !Revealing the symbols, not their number.
IF (MOVE(IT).GT.0) ALINE(21:21) = "+" !I want a leading + for positive, not zero.
WRITE (MSG,1) ALINE(1:27) !The SP format code is unhelpful for zero.
END DO !Hopefully, I'm still in sync with the input.
GO TO 10 !Perhaps another state follows.
Chew tape. The initial state is some sequence of symbols, starting at TAPE(1).
20 TAPE = CHAR(0) !Set every cell to zero. Not blank.
OFFSET = 12 !Affine shift. The numerical value of HEAD is not seen.
READ (INF,1) ALINE !Get text, for the tape's initial state.
L = LEN_TRIM(ALINE) !Last non-blank. Flexible format this isn't.
DO I = 1,L !Step through cells 1 to L.
TAPE(I + OFFSET - 1) = CHAR(INDEX(SYMBOLS,ALINE(I:I))) !Character code to symbol number.
END DO !Rather than reading as I1.
CLOSE (INF) !Finished with the input, and not much checking either.
WRITE (MSG,*) !Take a breath.
Cast forth a heading..
WRITE (MSG,99) !Announce.
99 FORMAT ("Starts with State 1 and the tape head at 1.") !Positioned for OFFSET = 12.
ALINE = " Step: Head State|Tape..." !Prepare a heading for the trace.
L = 18 + OFFSET*2 !Locate the start position.
ALINE(L - 1:L + 1) = "<H>"!No underlining, no overprinting, no colour (neither background nor foreground). Sigh.
WRITE (MSG,1) ALINE !Take that!
CALL CPU_TIME(T0) !Start the clock.
HEAD = OFFSET !This is counted as position one.
STATE = 1 !The initial state.
STEP = 0 !No steps yet.
Chase through the transitions. Could check that HEAD is within bounds FIRST:LAST.
100 IF (STEP.GE.200) GO TO 200 !Perhaps an extended campaign.
STEP = STEP + 1 !Otherwise, here we go.
DO I = 1,LONG/2 !Scan TAPE(1:LONG/2).
IT = 2*I - 1 !Allowing two positions each.
ALINE(IT:IT) = " " !So a leading space.
ALINE(IT + 1:IT + 1) = SYMBOL(ICHAR(TAPE(I))) !And the indicated symbol.
END DO !On to the enxt.
I = HEAD*2 !The head's location in the display span.
IF (I.GT.1 .AND. I.LT.LONG) THEN !Within range?
IF (ALINE(I:I).EQ.SYMBOL(0)) ALINE(I:I) = SYMBOL(1) !Yes. Am I looking at a new cell?
ALINE(I - 1:I - 1) = "<" !Bracket the head's cell.
ALINE(I + 1:I + 1) = ">" !In ALINE.
END IF !So much for showing the head's position.
WRITE (MSG,102) STEP,HEAD - OFFSET + 1,STATE,ALINE !Splot the state.
102 FORMAT (I5,":",I5,I6,"|",A) !Aligns with FORMAT 99.
I = STATE*NSYMBOL - ICHAR(TAPE(HEAD)) !For this STATE and the symbol under TAPE(HEAD)
HERE(I) = HERE(I) + 1 !Count my visits.
TAPE(HEAD) = MARK(I) !Place the new symbol.
HEAD = HEAD + MOVE(I) !Move the head.
IF (HEAD.LT.FIRST .OR. HEAD.GT.LAST) GO TO 110 !Check the bounds.
STATE = ICHAR(NEXT(I)) !The new state.
IF (STATE.GT.0) GO TO 100 !Go to it.
Cease.
I = HEAD*2 !Locate HEAD within ALINE.
IF (I.GT.1 .AND. I.LT.LONG) ALINE(I:I) = SYMBOL(ICHAR(TAPE(HEAD))) !The only change.
WRITE (MSG,103) HEAD - OFFSET + 1,STATE,ALINE !Show.
103 FORMAT ("HALT!",I6,I6,"|",A) !But, no step count to start with. See FORMAT 102.
GO TO 900 !Done.
Can't continue! Insufficient tape, alas.
110 WRITE (MSG,*) "Insufficient tape!" !Oh dear.
GO TO 900 !Give in.
Change into high gear: no trace and no test thereof neither.
200 STEP = STEP + 1 !So, advance.
IF (MOD(STEP,10000000).EQ.0) WRITE (MSG,201) STEP !Ah, still some timewasting.
201 FORMAT ("Step ",I0) !No screen action is rather discouraging.
I = STATE*NSYMBOL - ICHAR(TAPE(HEAD)) !Index the transition.
HERE(I) = HERE(I) + 1 !Another visit.
TAPE(HEAD) = MARK(I) !Do it. Possibly not changing the symbol.
HEAD = HEAD + MOVE(I) !Possibly not moving the head.
IF (HEAD.LT.FIRST .OR. HEAD.GT.LAST) GO TO 110 !But checking the bounds just in case.
STATE = ICHAR(NEXT(I)) !Hopefully, something has changed!
IF (STATE.GT.0) GO TO 200 !Otherwise, we might loop forever...
Closedown.
900 CALL CPU_TIME(T1) !Where did it all go?
WRITE (MSG,901) STEP,STATE !Announce the ending.
901 FORMAT ("After step ",I0,", state = ",I0,".") !Thus.
DO I = FIRST,LAST !Scan the tape.
IF (ICHAR(TAPE(I)).NE.0) EXIT !This is the whole point of SYMBOL(0).
END DO !So that the bounds
DO J = LAST,FIRST,-1 !Of tape access
IF (ICHAR(TAPE(J)).NE.0) EXIT !(and placement of the initial state)
END DO !Can be found without tedious ongoing MIN and MAX.
WRITE (MSG,902) HEAD - OFFSET + 1, !Tediously,
1 I - OFFSET + 1, !Reverse the offset
2 J - OFFSET + 1 !So as to seem that HEAD = 1, to start with.
902 FORMAT ("The head is at position ",I0, !Now announce the results.
1 " and wandered over ",I0," to ",I0) !This will affect the dimension chosen for TAPE.
T1 = T1 - T0 !Some time may have been accurately measured.
IF (T1.GT.0.1) WRITE (MSG,903) T1 !And this may be sort of correct.
903 FORMAT ("CPU time",F9.3) !Though distinct from elapsed time.
Curious about the usage of the transition table?
910 WRITE (MSG,911) !Possibly not,
911 FORMAT (/,35X,"Usage.") !But here it comes.
DO STATE = 1,NSTATE !For every state
WRITE (MSG,11) STATE !Name the state, as before.
DO S = 0,NSYMBOL - 1 !But this time, roll every symbol.
IT = STATE*NSYMBOL - S !Including my "secret" symbol.
WRITE (ALINE,12) IT,SYMBOL(S), !The same sequence,
1 SYMBOL(ICHAR(MARK(IT))),MOVE(IT),ICHAR(NEXT(IT)),HERE(IT) !But with an addendum here.
IF (MOVE(IT).GT.0) ALINE(21:21) = "+" !SIGN(i,i) gives -1, 0, +1 but -60 for -60.
WRITE (MSG,1) ALINE(1:40) !When what I want is -1. SIGN(1,i) doesn't give zero.
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.

177
Task/Universal-Turing-machine/Go/universal-turing-machine-1.go Normal file
View file

@ -0,0 +1,177 @@
package turing
type Symbol byte
type Motion byte
const (
Left Motion = 'L'
Right Motion = 'R'
Stay Motion = 'N'
)
type Tape struct {
data []Symbol
pos, left int
blank Symbol
}
// NewTape returns a new tape filled with 'data' and position set to 'start'.
// 'start' does not need to be range, the tape will be extended if required.
func NewTape(blank Symbol, start int, data []Symbol) *Tape {
t := &Tape{
data: data,
blank: blank,
}
if start < 0 {
t.Left(-start)
}
t.Right(start)
return t
}
func (t *Tape) Stay() {}
func (t *Tape) Data() []Symbol { return t.data[t.left:] }
func (t *Tape) Read() Symbol { return t.data[t.pos] }
func (t *Tape) Write(s Symbol) { t.data[t.pos] = s }
func (t *Tape) Dup() *Tape {
t2 := &Tape{
data: make([]Symbol, len(t.Data())),
blank: t.blank,
}
copy(t2.data, t.Data())
t2.pos = t.pos - t.left
return t2
}
func (t *Tape) String() string {
s := ""
for i := t.left; i < len(t.data); i++ {
b := t.data[i]
if i == t.pos {
s += "[" + string(b) + "]"
} else {
s += " " + string(b) + " "
}
}
return s
}
func (t *Tape) Move(a Motion) {
switch a {
case Left:
t.Left(1)
case Right:
t.Right(1)
case Stay:
t.Stay()
}
}
const minSz = 16
func (t *Tape) Left(n int) {
t.pos -= n
if t.pos < 0 {
// Extend left
var sz int
for sz = minSz; cap(t.data[t.left:])-t.pos >= sz; sz <<= 1 {
}
newd := make([]Symbol, sz)
newl := len(newd) - cap(t.data[t.left:])
n := copy(newd[newl:], t.data[t.left:])
t.data = newd[:newl+n]
t.pos += newl - t.left
t.left = newl
}
if t.pos < t.left {
if t.blank != 0 {
for i := t.pos; i < t.left; i++ {
t.data[i] = t.blank
}
}
t.left = t.pos
}
}
func (t *Tape) Right(n int) {
t.pos += n
if t.pos >= cap(t.data) {
// Extend right
var sz int
for sz = minSz; t.pos >= sz; sz <<= 1 {
}
newd := make([]Symbol, sz)
n := copy(newd[t.left:], t.data[t.left:])
t.data = newd[:t.left+n]
}
if i := len(t.data); t.pos >= i {
t.data = t.data[:t.pos+1]
if t.blank != 0 {
for ; i < len(t.data); i++ {
t.data[i] = t.blank
}
}
}
}
type State string
type Rule struct {
State
Symbol
Write Symbol
Motion
Next State
}
func (i *Rule) key() key { return key{i.State, i.Symbol} }
func (i *Rule) action() action { return action{i.Write, i.Motion, i.Next} }
type key struct {
State
Symbol
}
type action struct {
write Symbol
Motion
next State
}
type Machine struct {
tape *Tape
start, state State
transition map[key]action
l func(string, ...interface{}) // XXX
}
func NewMachine(rules []Rule) *Machine {
m := &Machine{transition: make(map[key]action, len(rules))}
if len(rules) > 0 {
m.start = rules[0].State
}
for _, r := range rules {
m.transition[r.key()] = r.action()
}
return m
}
func (m *Machine) Run(input *Tape) (int, *Tape) {
m.tape = input.Dup()
m.state = m.start
for cnt := 0; ; cnt++ {
if m.l != nil {
m.l("%3d %4s: %v\n", cnt, m.state, m.tape)
}
sym := m.tape.Read()
act, ok := m.transition[key{m.state, sym}]
if !ok {
return cnt, m.tape
}
m.tape.Write(act.write)
m.tape.Move(act.Motion)
m.state = act.next
}
}

71
Task/Universal-Turing-machine/Go/universal-turing-machine-2.go Normal file
View file

@ -0,0 +1,71 @@
package main
import (
".." // XXX path to above turing package
"fmt"
)
func main() {
var incrementer = turing.NewMachine([]turing.Rule{
{"q0", '1', '1', turing.Right, "q0"},
{"q0", 'B', '1', turing.Stay, "qf"},
})
input := turing.NewTape('B', 0, []turing.Symbol{'1', '1', '1'})
cnt, output := incrementer.Run(input)
fmt.Println("Turing machine halts after", cnt, "operations")
fmt.Println("Resulting tape:", output)
var beaver = turing.NewMachine([]turing.Rule{
{"a", '0', '1', turing.Right, "b"},
{"a", '1', '1', turing.Left, "c"},
{"b", '0', '1', turing.Left, "a"},
{"b", '1', '1', turing.Right, "b"},
{"c", '0', '1', turing.Left, "b"},
{"c", '1', '1', turing.Stay, "halt"},
})
cnt, output = beaver.Run(turing.NewTape('0', 0, nil))
fmt.Println("Turing machine halts after", cnt, "operations")
fmt.Println("Resulting tape:", output)
beaver = turing.NewMachine([]turing.Rule{
{"A", '0', '1', turing.Right, "B"},
{"A", '1', '1', turing.Left, "C"},
{"B", '0', '1', turing.Right, "C"},
{"B", '1', '1', turing.Right, "B"},
{"C", '0', '1', turing.Right, "D"},
{"C", '1', '0', turing.Left, "E"},
{"D", '0', '1', turing.Left, "A"},
{"D", '1', '1', turing.Left, "D"},
{"E", '0', '1', turing.Stay, "H"},
{"E", '1', '0', turing.Left, "A"},
})
cnt, output = beaver.Run(turing.NewTape('0', 0, nil))
fmt.Println("Turing machine halts after", cnt, "operations")
fmt.Println("Resulting tape has", len(output.Data()), "cells")
var sort = turing.NewMachine([]turing.Rule{
// Moving right, first b→B;s1
{"s0", 'a', 'a', turing.Right, "s0"},
{"s0", 'b', 'B', turing.Right, "s1"},
{"s0", ' ', ' ', turing.Left, "se"},
// Conintue right to end of tape → s2
{"s1", 'a', 'a', turing.Right, "s1"},
{"s1", 'b', 'b', turing.Right, "s1"},
{"s1", ' ', ' ', turing.Left, "s2"},
// Continue left over b. a→b;s3, B→b;se
{"s2", 'a', 'b', turing.Left, "s3"},
{"s2", 'b', 'b', turing.Left, "s2"},
{"s2", 'B', 'b', turing.Left, "se"},
// Continue left until B→a;s0
{"s3", 'a', 'a', turing.Left, "s3"},
{"s3", 'b', 'b', turing.Left, "s3"},
{"s3", 'B', 'a', turing.Right, "s0"},
// Move to tape start → halt
{"se", 'a', 'a', turing.Left, "se"},
{"se", ' ', ' ', turing.Right, "see"},
})
input = turing.NewTape(' ', 0, []turing.Symbol("abbabbabababab"))
cnt, output = sort.Run(input)
fmt.Println("Turing machine halts after", cnt, "operations")
fmt.Println("Resulting tape:", output)
}

28
Task/Universal-Turing-machine/Haskell/universal-turing-machine-1.hs Normal file
View file

@ -0,0 +1,28 @@
-- Some elementary types for Turing Machine
data Move = MLeft | MRight | Stay deriving (Show, Eq)
data Tape a = Tape a [a] [a]
data Action state val = Action val Move state deriving (Show)
instance (Show a) => Show (Tape a) where
show (Tape x lts rts) = concat $ left ++ [hd] ++ right
where hd = "[" ++ show x ++ "]"
left = map show $ reverse $ take 10 lts
right = map show $ take 10 rts
-- new tape
tape blank lts rts | null rts = Tape blank left blanks
| otherwise = Tape (head rts) left right
where blanks = repeat blank
left = reverse lts ++ blanks
right = tail rts ++ blanks
-- Turing Machine
step rules (state, Tape x (lh:lts) (rh:rts)) = (state', tape')
where Action x' dir state' = rules state x
tape' = move dir
move Stay = Tape x' (lh:lts) (rh:rts)
move MLeft = Tape lh lts (x':rh:rts)
move MRight = Tape rh (x':lh:lts) rts
runUTM rules stop start tape = steps ++ [final]
where (steps, final:_) = break ((== stop) . fst) $ iterate (step rules) (start, tape)

5
Task/Universal-Turing-machine/Haskell/universal-turing-machine-2.hs Normal file
View file

@ -0,0 +1,5 @@
incr "q0" 1 = Action 1 MRight "q0"
incr "q0" 0 = Action 1 Stay "qf"
tape1 = tape 0 [] [1,1, 1]
machine1 = runUTM incr "qf" "q0" tape1

6
Task/Universal-Turing-machine/Haskell/universal-turing-machine-3.hs Normal file
View file

@ -0,0 +1,6 @@
*Main> mapM_ print machine1
("q0",0000000000[1]1100000000)
("q0",0000000001[1]1000000000)
("q0",0000000011[1]0000000000)
("q0",0000000111[0]0000000000)
("qf",0000000111[1]0000000000)

9
Task/Universal-Turing-machine/Haskell/universal-turing-machine-4.hs Normal file
View file

@ -0,0 +1,9 @@
beaver "a" 0 = Action 1 MRight "b"
beaver "a" 1 = Action 1 MLeft "c"
beaver "b" 0 = Action 1 MLeft "a"
beaver "b" 1 = Action 1 MRight "b"
beaver "c" 0 = Action 1 MLeft "b"
beaver "c" 1 = Action 1 Stay "halt"
tape2 = tape 0 [] []
machine2 = runUTM beaver "halt" "a" tape2

17
Task/Universal-Turing-machine/Haskell/universal-turing-machine-5.hs Normal file
View file

@ -0,0 +1,17 @@
sorting "A" 1 = Action 1 MRight "A"
sorting "A" 2 = Action 3 MRight "B"
sorting "A" 0 = Action 0 MLeft "E"
sorting "B" 1 = Action 1 MRight "B"
sorting "B" 2 = Action 2 MRight "B"
sorting "B" 0 = Action 0 MLeft "C"
sorting "C" 1 = Action 2 MLeft "D"
sorting "C" 2 = Action 2 MLeft "C"
sorting "C" 3 = Action 2 MLeft "E"
sorting "D" 1 = Action 1 MLeft "D"
sorting "D" 2 = Action 2 MLeft "D"
sorting "D" 3 = Action 1 MRight "A"
sorting "E" 1 = Action 1 MLeft "E"
sorting "E" 0 = Action 0 MRight "STOP"
tape3 = tape 0 [] [2,2,2,1,2,2,1,2,1,2,1,2,1,2]
machine3 = runUTM sorting "STOP" "A" tape3

152
Task/Universal-Turing-machine/Haskell/universal-turing-machine-6.hs Normal file
View file

@ -0,0 +1,152 @@
import Control.Monad.State
import Data.List (intersperse, nub, find)
data TapeMovement = MoveLeft | MoveRight | Stay deriving (Show, Eq)
-- Rule = (state 1, input, output, movement, state 2)
type Rule a = (a, a, a, TapeMovement, a)
-- Execution = (tape position, current machine state, tape)
type Execution a = (Int, a, [a])
type Log a = [Execution a]
type UTM a b = State (Machine a) b
-- can work with data of any type
data Machine a = Machine
{ allStates :: [a] -- not used actually
, initialState :: a -- not used actually, initial state in "current"
, finalStates :: [a]
, symbols :: [a] -- not used actually
, blank :: a
, noOpSymbol :: a -- means: don't change input / don't shift tape
, rules :: [Rule a]
, current :: Execution a
, machineLog :: Log a -- stores state changes from last to first
, machineLogActive :: Bool -- if true, intermediate steps are stored
, noRuleMsg :: a -- error symbol if no rule matches
, stopMsg :: a } -- symbol to append to the end result
deriving (Show)
-- it is not checked whether the input and output symbols are valid
apply :: Eq a => Rule a -> UTM a a
apply (_, _, output, direction, stateUpdate) = do
m <- get
let (pos, currentState, tape) = current m
tapeUpdate = if output == noOpSymbol m
then tape
else take pos tape ++ [output] ++ drop (pos + 1) tape
newTape
| pos == 0 && direction == MoveLeft = blank m : tapeUpdate
| succ pos == length tape && direction == MoveRight = tapeUpdate ++ [blank m]
| otherwise = tapeUpdate
newPosition = case direction of
MoveLeft -> if pos == 0 then 0 else pred pos
MoveRight -> succ pos
Stay -> pos
newState = if stateUpdate == noOpSymbol m
then currentState
else stateUpdate
put $! m { current = (newPosition, newState, newTape) }
return newState
-- rules with no-operation symbols and states must be underneath
-- rules with defined symbols and states
lookupRule :: Eq a => UTM a (Maybe (Rule a))
lookupRule = do
m <- get
let (pos, currentState, tape) = current m
item = tape !! pos
isValid (e, i, _, _, _) = e == currentState &&
(i == item || i == noOpSymbol m)
return $! find isValid (rules m)
msgToLog :: a -> UTM a ()
msgToLog e = do
m <- get
let (pos, currentState, tape) = current m
put $! m { machineLog = (pos, currentState, tape ++ [e]) : machineLog m }
toLog :: UTM a ()
toLog = do
m <- get
put $! m { machineLog = current m : machineLog m }
-- execute the machine's program
execute :: Eq a => UTM a ()
execute = do
toLog -- log the initial state
loop
where
loop = do
m <- get
r <- lookupRule -- look for a matching rule
case r of
Nothing -> msgToLog (noRuleMsg m)
Just rule -> do
stateUpdate <- apply rule
if stateUpdate `elem` finalStates m
then msgToLog (stopMsg m)
else do
when (machineLogActive m) toLog
loop
---------------------------
-- convenient functions
---------------------------
-- run execute, format and print the output
runMachine :: Machine String -> IO ()
runMachine m@(Machine { current = (_, _, tape) }) =
if null tape
then putStrLn "NO TAPE"
else case machineLog $ execState execute m of
[] -> putStrLn "NO OUTPUT"
xs -> do
mapM_ (\(pos, _, output) -> do
let formatOutput = concat output
putStrLn formatOutput
putStrLn (replicate pos ' ' ++ "^")) $ reverse xs
putStrLn $ show (length xs) ++ " STEPS. FINAL STATE: " ++
let (_, finalState, _) = head xs in show finalState
-- convert a string with format state+space+input+space+output+space+
-- direction+space+new state to a rule
toRule :: String -> Rule String
toRule xs =
let [a, b, c, d, e] = take 5 $ words xs
dir = case d of
"l" -> MoveLeft
"r" -> MoveRight
"*" -> Stay
in (a, b, c, dir, e)
-- load a text file and parse it to a machine.
-- see comments and examples
-- lines in the file starting with ';' are header lines or comments
-- header and input lines must contain a ':' and after that the content to be parsed
-- so there can be comments between ';' and ':' in those lines
loadMachine :: FilePath -> IO (Machine String)
loadMachine n = do
f <- readFile n
let ls = lines f
-- header: first 4 lines
([e1, e2, e3, e4], rest) = splitAt 4 ls
-- rules and input: rest of the file
re = map toRule . filter (not . null) $ map (takeWhile (/= ';')) rest
ei = head . words . tail . snd $ break (== ':') e1
va = head . words . tail . snd $ break (== ':') e3
ci = words . intersperse ' ' . tail . snd $ break (== ':') $ last rest
return Machine
{ rules = re
, initialState = ei
, finalStates = words . tail . snd $ break (== ':') e2
, blank = va
, noOpSymbol = head . words . tail . snd $ break (== ':') e4
, allStates = nub $ concatMap (\(a, _, _, _, e) -> [a, e]) re
, symbols = nub $ concatMap (\(_, b, c, _, _) -> [b, c]) re
, current = (0, ei, if null ci then [va] else ci)
-- we assume
, noRuleMsg = "\tNO RULE." -- error: no matching rule found
, stopMsg = "\tHALT." -- message: machine reached a final state
, machineLog = []
, machineLogActive = True }

118
Task/Universal-Turing-machine/Icon/universal-turing-machine.icon Normal file
View file

@ -0,0 +1,118 @@
record TM(start,final,delta,tape,blank)
record delta(old_state, input_symbol, new_state, output_symbol, direction)
global start_tape
global show_count, full_display, trace_list # trace flags
procedure main(args)
init(args)
runTuringMachine(get_tm())
end
procedure init(args)
trace_list := ":"
while arg := get(args) do {
if arg == "-f" then full_display := "yes"
else if match("-t",arg) then trace_list ||:= arg[3:0]||":"
else show_count := integer(arg)
}
end
procedure get_tm()
D := table()
writes("What is the start state? ")
start := !&input
writes("What are the final states (colon separated)? ")
finals := !&input
(finals||":") ? every insert(fStates := set(), 1(tab(upto(':')),move(1)))
writes("What is the tape blank symbol?")
blank := !&input
write("Enter the delta mappings, using the following format:")
write("\tenter delta(curState,tapeSymbol) = (newState,newSymbol,direct) as")
write("\t curState:tapeSymbol:newState:newSymbol:direct");
write("\t\twhere direct is left, right, stay, or halt")
write("End with a blank line.")
write("")
every line := !&input do {
if *line = 0 then break
line ?
if (os := tab(upto(':')), move(1), ic := tab(upto(':')), move(1),
ns := tab(upto(':')), move(1), oc := tab(upto(':')), move(1),
d := map(tab(0))) then D[os||":"||ic] := delta(os,ic,ns,oc,d)
else write(line, " is in bad form, correct it")
}
if /start_tape then {
write("Enter the input tape")
start_tape := !&input
}
return TM(start,fStates,D,start_tape,blank)
end
procedure runTuringMachine(tm)
trans := tm.delta
rightside := tm.tape
if /rightside | (*rightside = 0) then rightside := tm.blank
leftside := ""
cur_state := tm.start
write("Machine starts in ",cur_state," with tape:")
show_tape(tm,leftside,rightside)
while mapping := \trans[cur_state||":"||rightside[1]] do {
rightside[1] := mapping.output_symbol
case mapping.direction of {
"left" : {
if *leftside = 0 then leftside := tm.blank
rightside := leftside[-1] || rightside
leftside[-1] := ""
}
"right" : {
leftside ||:= rightside[1]
rightside[1] := ""
if *rightside = 0 then rightside := tm.blank
}
"halt" : break
}
cur_state := mapping.new_state
if member(tm.final,cur_state) then break
trace(tm,cur_state,leftside,rightside)
}
write()
write("Machine halts in ",cur_state," with tape:")
show_tape(tm,leftside,rightside)
end
procedure trace(tm,cs,ls,rs)
static count, last_state
initial {
count := 0
last_state := ""
}
count +:= 1
if \show_count & (count % show_count = 0) then show_tape(tm,ls,rs)
if find(":"||cs||":",trace_list) & (last_state ~== cs) then {
writes("\tnow in state: ",cs," ")
if \full_display then show_delta(tm.delta[cs||":"||rs[1]])
else write()
}
last_state := cs
return
end
procedure show_delta(m)
if /m then write("NO MOVE!")
else {
writes("\tnext move is ")
writes("delta(",m.old_state,",",m.input_symbol,") ::= ")
write("(",m.new_state,",",m.output_symbol,",",m.direction,")")
}
end
procedure show_tape(tm,l,r)
l := reverse(trim(reverse(l),tm.blank))
r := trim(r,tm.blank)
write(l,r)
write(repl(" ",*l),"^")
end

16
Task/Universal-Turing-machine/J/universal-turing-machine-1.j Normal file
View file

@ -0,0 +1,16 @@
". noun define -. CRLF NB. Fixed tacit universal Turing machine code...
utm=.
(((":@:(]&:>)@:(6&({::)) ,: (":@] 9&({::))) ,. ':'"_) ,. 2&({::) >@:(((48 + ]
) { a."_)@[ ; (] $ ' '"_) , '^'"_) 3&({::))@:([ (0 0 $ 1!:2&2)@:('A changeles
s cycle was detected!'"_)^:(-.@:(_1"_ = 1&({::))))@:((((3&({::) + 8&({::)) ;
1 + 9&({::)) 3 9} ])@:(<@:((0 (0 {:: ])`(<@:(1 {:: ]))`(2 {:: ])} ])@:(7 3 2&
{)) 2} ])@:(<"0@:(6&({::) (<@[ { ]) 0&({::)) 7 8 1} ])@:([ (0 0 $ 1!:2&2)@:((
(":@:(]&:>)@:(6&({::)) ,: (":@] 9&({::))) ,. ':'"_) ,. 2&({::) >@:(((48 + ])
{ a."_)@[ ; (] $ ' '"_) , '^'"_) 3&({::))^:(0 = 4&({::) | 9&({::)))@:(<@:(1&(
{::) ; 3&({::) { 2&({::)) 6} ])@:(<@:(3&({::) + _1 = 3&({::)) 3} ])@:(<@:(((_
1 = 3&({::)) {:: 5&({::)) , 2&({::) , (3&({::) = #@:(2&({::))) {:: 5&({::)) 2
} ])^:(-.@:(_1"_ = 1&({::)))^:_)@:((0 ; (({. , ({: % 3:) , 3:)@:$ $ ,)@:(}."1
)@:(".;._2)@:(0&({::))) 9 0} ])@:(<@:('' ; 0"_) 5} ])@:(,&(;:',,,,,'))@:(,~)
)

21
Task/Universal-Turing-machine/J/universal-turing-machine-2.j Normal file
View file

@ -0,0 +1,21 @@
Noun=. ".@('(0 : 0)'"_)
NB. Simple Incrementer...
NB. 0 1 Tape Symbol Scan
NB. S p m g p m g (p,m,g) → (print,move,goto)
QS=. (Noun _) ; 0 NB. Reading the transition table and setting the initial state
0 1 0 _1 1 1 0
)
TPF=. 1 1 1 ; 0 ; 1 NB. Setting the tape, its pointer and the display frequency
TPF utm QS NB. Running the Turing machine...
0 1:111
0 :^
0 1:111
1 : ^
0 1:111
2 : ^
0 0:1110
3 : ^
0 0:1111
4 : ^

39
Task/Universal-Turing-machine/J/universal-turing-machine-3.j Normal file
View file

@ -0,0 +1,39 @@
NB. Three-state busy beaver..
NB. 0 1 Tape Symbol Scan
NB. S p m g p m g (p,m,g) → (print,move,goto)
QS=. (Noun _) ; 0 NB. Reading the transition table and setting the initial state
0 1 1 1 1 _1 2
1 1 _1 0 1 1 1
2 1 _1 1 1 0 _1
)
TPF=. 0 ; 0 ; 1 NB. Setting the tape, its pointer and the display frequency
TPF utm QS NB. Running the Turing machine...
0 0:0
0 :^
1 0:10
1 : ^
0 1:11
2 :^
2 0:011
3 :^
1 0:0111
4 :^
0 0:01111
5 :^
1 1:11111
6 : ^
1 1:11111
7 : ^
1 1:11111
8 : ^
1 1:11111
9 : ^
1 0:111110
10 : ^
0 1:111111
11 : ^
2 1:111111
12 : ^
2 1:111111
13 : ^

17
Task/Universal-Turing-machine/J/universal-turing-machine-4.j Normal file
View file

@ -0,0 +1,17 @@
NB. Probable 5-state, 2-symbol busy beaver...
NB. 0 1 Tape Symbol Scan
NB. S p m g p m g (p,m,g) → (print,move,goto)
QS=. (Noun _) ; 0 NB. Reading the transition table and setting the state
0 1 1 1 1 _1 2
1 1 1 2 1 1 1
2 1 1 3 0 _1 4
3 1 _1 0 1 _1 3
4 1 1 _1 0 _1 0
)
TPF=. 0 ; 0 ; _ NB. Setting the tape, its pointer and the display frequency
TPF utm QS NB. Running the Turing machine...
0 0:0
0 :^
4 0 :101001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001...
47176870: ^

21
Task/Universal-Turing-machine/J/universal-turing-machine-5.j Normal file
View file

@ -0,0 +1,21 @@
NB. Sorting stress test...
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)
QS=. (Noun _) ; 0 NB. Reading the transition table and setting the initial state
0 0 _1 4 1 1 0 3 1 1 _ _ _
1 0 _1 2 1 1 1 2 1 1 _ _ _
2 _ _ _ 2 _1 3 2 _1 2 2 _1 4
3 _ _ _ 1 _1 3 2 _1 3 1 1 0
4 0 1 _1 1 _1 4 _ _ _ _ _ _
)
TPF=. 1 2 2 1 2 2 1 2 1 2 1 2 1 2 ; 0 ; 50 NB. Setting the tape, its pointer and the display frequency
TPF utm QS NB. Running the Turing machine...
0 1:12212212121212
0 :^
3 2:113122121222220
50 : ^
1 2:111111322222220
100: ^
4 0:0111111222222220
118: ^

95
Task/Universal-Turing-machine/J/universal-turing-machine-6.j Normal file
View file

@ -0,0 +1,95 @@
NB. Structured derivation of the universal Turing machine...
NB.--------------------------------------------------------------------------------------
NB. Quick and dirty tacit toolkit...
o=. @:
c=."_
ver=. (0:`)([:^:)
d=. (fix=. (;:'f.')ver) (train=.(;:'`:')ver&6) (an=. <@:((,'0') (,&<) ]))
ver=. (an f. o fix'ver')ver o an f.
z=. ((an'')`($ ,)`) (`:6)
d=. (a0=. `'') (a1=. (@:[) ((<'&')`) (`:6)) (a2=. (`(<(":0);_)) (`:6))
av=. ((an o fix'a0')`) (`(an o fix'a1')) (`(an o fix'a2') ) (`:6)
Fetch=. (ver o train ;:'&{::')&.> o i. f.av
tie=. ver o train ;:'`'
indices=. (, $~ 1 -.~ $) o (train"0 o ((1 -: L.)S:1 # <S:1) o (tie&'') o fix :: ] @:[)
f=. ((ver o train ;:'&{')) o indices o train f.av
'A B'=. 2 Fetch
head=. (;:'<@:') {.~ 2 * 1 = # o [
h=. train o (indices o train o (A f) (head , (B f) o ] , < o an o [ , (;:'}]')c) ]) f.av
DropIfNB=. < o ('('"_ , ] , ')'"_) o ((}: ^: ('NB.' -: 3&{. o > o {:)) &. ;:)
pipe=. ([ , ' o ' , ])&:>/ o |.
is=. ". o (, o ": o > , '=. ' , pipe o (DropIfNB;._2) o ". o ('0 ( : 0)'c)) f.av
NB.--------------------------------------------------------------------------------------
NB. Producing the main (dyadic) verb utm...
Note 0
NB. X (boxed list)...
Q - Instruction table
S - Turing machine initial state
NB. Y (boxed list)...
T - Data tape
P - Head position pointer
F - Display frequency
NB. Local...
B - Blank defaults
M - State and tape symbol read
PRINT - Printing symbol
MOVE - Tape head moving instruction
C - Step Counter
)
'Q S T P F B M PRINT MOVE C'=. 10 Fetch NB. Fetching 10 Boxes
DisplayTape=. > o (((48 + ]) { a.c)@[ ; ((] $ ' 'c) , '^'c))
display=. ((((": o (]&:>) o M) ,: (":@] C)) ,. ':'c ) ,. (T DisplayTape P))
NB. Displaying state, symbol, tape / step and pointer
amend=. 0 (0 {:: ])`(<@:(1 {:: ]))`(2 {:: ])} ]
NB. execute (monadic verb)...
FillLeft=. (_1 = P ) {:: B NB. Expanding and filling the tape
FillRight=. ( P = # o T) {:: B NB. with 0's (if necessary)
ia=. <@[ { ] NB. Selecting by the indices of an array
execute is
T`(FillLeft , T , FillRight)h NB. Adjusting the tape
P`(P + _1 = P) h NB. and the pointer (if necessary)
M`(S ; P { T) h NB. Updating the state and reading the tape symbol
[ (smoutput o display)^:(0 = F | C) NB. Displaying intermediate cycles
(PRINT MOVE S)`(<"0 o (M ia Q))h NB. Performing the printing, moving and state actions
T`(amend o ((PRINT P T)f)) h NB. Printing symbol on tape at the pointer position
(P C)`((P + MOVE) ; 1 + C) h NB. Updating the pointer and the counter
)
cc=. 'A changeless cycle was detected!'c
halt=. _1 c = S NB. Halting when the current state is _1
rt=. ((({. , ({: % 3:) , 3:) o $) $ ,) o (}."1) o (". ;. _2)
NB. Reshaping the transition table as a 3D array (state,symbol,action)
utm is NB. Universal Turing Machine (dyadic verb)
,~ NB. Appending the arguments in reverse order
,&(;:5$',') NB. Appending 5 local boxes (B M PRINT MOVE C)
B`('' ; 0 c) h NB. Setting empty blank defaults as 0
(C Q)`(0 ; rt o Q)h NB. Setting the counter and the transition table
execute^:(-. o halt)^:_ NB. Executing until a halt instruction is issued
[ smoutput o cc ^: (-. o halt) NB. or a changeless single cycle is detected
display NB. Displaying (returning) the final status
)
utm=. utm f. NB. Fixing the universal Turing machine code
NB. The simulation code is produced by 77 (-@:[ ]\ 5!:5@<@:]) 'utm'

238
Task/Universal-Turing-machine/Java/universal-turing-machine.java Normal file
View file

@ -0,0 +1,238 @@
import java.util.HashMap;
import java.util.HashSet;
import java.util.LinkedList;
import java.util.ListIterator;
import java.util.List;
import java.util.Set;
import java.util.Map;
public class UTM {
private List<String> tape;
private String blankSymbol;
private ListIterator<String> head;
private Map<StateTapeSymbolPair, Transition> transitions = new HashMap<StateTapeSymbolPair, Transition>();
private Set<String> terminalStates;
private String initialState;
public UTM(Set<Transition> transitions, Set<String> terminalStates, String initialState, String blankSymbol) {
this.blankSymbol = blankSymbol;
for (Transition t : transitions) {
this.transitions.put(t.from, t);
}
this.terminalStates = terminalStates;
this.initialState = initialState;
}
public static class StateTapeSymbolPair {
private String state;
private String tapeSymbol;
public StateTapeSymbolPair(String state, String tapeSymbol) {
this.state = state;
this.tapeSymbol = tapeSymbol;
}
// These methods can be auto-generated by Eclipse.
@Override
public int hashCode() {
final int prime = 31;
int result = 1;
result = prime * result
+ ((state == null) ? 0 : state.hashCode());
result = prime
* result
+ ((tapeSymbol == null) ? 0 : tapeSymbol
.hashCode());
return result;
}
// These methods can be auto-generated by Eclipse.
@Override
public boolean equals(Object obj) {
if (this == obj)
return true;
if (obj == null)
return false;
if (getClass() != obj.getClass())
return false;
StateTapeSymbolPair other = (StateTapeSymbolPair) obj;
if (state == null) {
if (other.state != null)
return false;
} else if (!state.equals(other.state))
return false;
if (tapeSymbol == null) {
if (other.tapeSymbol != null)
return false;
} else if (!tapeSymbol.equals(other.tapeSymbol))
return false;
return true;
}
@Override
public String toString() {
return "(" + state + "," + tapeSymbol + ")";
}
}
public static class Transition {
private StateTapeSymbolPair from;
private StateTapeSymbolPair to;
private int direction; // -1 left, 0 neutral, 1 right.
public Transition(StateTapeSymbolPair from, StateTapeSymbolPair to, int direction) {
this.from = from;
this.to = to;
this.direction = direction;
}
@Override
public String toString() {
return from + "=>" + to + "/" + direction;
}
}
public void initializeTape(List<String> input) { // Arbitrary Strings as symbols.
tape = input;
}
public void initializeTape(String input) { // Uses single characters as symbols.
tape = new LinkedList<String>();
for (int i = 0; i < input.length(); i++) {
tape.add(input.charAt(i) + "");
}
}
public List<String> runTM() { // Returns null if not in terminal state.
if (tape.size() == 0) {
tape.add(blankSymbol);
}
head = tape.listIterator();
head.next();
head.previous();
StateTapeSymbolPair tsp = new StateTapeSymbolPair(initialState, tape.get(0));
while (transitions.containsKey(tsp)) { // While a matching transition exists.
System.out.println(this + " --- " + transitions.get(tsp));
Transition trans = transitions.get(tsp);
head.set(trans.to.tapeSymbol); // Write tape symbol.
tsp.state = trans.to.state; // Change state.
if (trans.direction == -1) { // Go left.
if (!head.hasPrevious()) {
head.add(blankSymbol); // Extend tape.
}
tsp.tapeSymbol = head.previous(); // Memorize tape symbol.
} else if (trans.direction == 1) { // Go right.
head.next();
if (!head.hasNext()) {
head.add(blankSymbol); // Extend tape.
head.previous();
}
tsp.tapeSymbol = head.next(); // Memorize tape symbol.
head.previous();
} else {
tsp.tapeSymbol = trans.to.tapeSymbol;
}
}
System.out.println(this + " --- " + tsp);
if (terminalStates.contains(tsp.state)) {
return tape;
} else {
return null;
}
}
@Override
public String toString() {
try {
int headPos = head.previousIndex();
String s = "[ ";
for (int i = 0; i <= headPos; i++) {
s += tape.get(i) + " ";
}
s += "[H] ";
for (int i = headPos + 1; i < tape.size(); i++) {
s += tape.get(i) + " ";
}
return s + "]";
} catch (Exception e) {
return "";
}
}
public static void main(String[] args) {
// Simple incrementer.
String init = "q0";
String blank = "b";
Set<String> term = new HashSet<String>();
term.add("qf");
Set<Transition> trans = new HashSet<Transition>();
trans.add(new Transition(new StateTapeSymbolPair("q0", "1"), new StateTapeSymbolPair("q0", "1"), 1));
trans.add(new Transition(new StateTapeSymbolPair("q0", "b"), new StateTapeSymbolPair("qf", "1"), 0));
UTM machine = new UTM(trans, term, init, blank);
machine.initializeTape("111");
System.out.println("Output (si): " + machine.runTM() + "\n");
// Busy Beaver (overwrite variables from above).
init = "a";
term.clear();
term.add("halt");
blank = "0";
trans.clear();
// Change state from "a" to "b" if "0" is read on tape, write "1" and go to the right. (-1 left, 0 nothing, 1 right.)
trans.add(new Transition(new StateTapeSymbolPair("a", "0"), new StateTapeSymbolPair("b", "1"), 1));
trans.add(new Transition(new StateTapeSymbolPair("a", "1"), new StateTapeSymbolPair("c", "1"), -1));
trans.add(new Transition(new StateTapeSymbolPair("b", "0"), new StateTapeSymbolPair("a", "1"), -1));
trans.add(new Transition(new StateTapeSymbolPair("b", "1"), new StateTapeSymbolPair("b", "1"), 1));
trans.add(new Transition(new StateTapeSymbolPair("c", "0"), new StateTapeSymbolPair("b", "1"), -1));
trans.add(new Transition(new StateTapeSymbolPair("c", "1"), new StateTapeSymbolPair("halt", "1"), 0));
machine = new UTM(trans, term, init, blank);
machine.initializeTape("");
System.out.println("Output (bb): " + machine.runTM());
// Sorting test (overwrite variables from above).
init = "s0";
blank = "*";
term = new HashSet<String>();
term.add("see");
trans = new HashSet<Transition>();
trans.add(new Transition(new StateTapeSymbolPair("s0", "a"), new StateTapeSymbolPair("s0", "a"), 1));
trans.add(new Transition(new StateTapeSymbolPair("s0", "b"), new StateTapeSymbolPair("s1", "B"), 1));
trans.add(new Transition(new StateTapeSymbolPair("s0", "*"), new StateTapeSymbolPair("se", "*"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s1", "a"), new StateTapeSymbolPair("s1", "a"), 1));
trans.add(new Transition(new StateTapeSymbolPair("s1", "b"), new StateTapeSymbolPair("s1", "b"), 1));
trans.add(new Transition(new StateTapeSymbolPair("s1", "*"), new StateTapeSymbolPair("s2", "*"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s2", "a"), new StateTapeSymbolPair("s3", "b"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s2", "b"), new StateTapeSymbolPair("s2", "b"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s2", "B"), new StateTapeSymbolPair("se", "b"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s3", "a"), new StateTapeSymbolPair("s3", "a"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s3", "b"), new StateTapeSymbolPair("s3", "b"), -1));
trans.add(new Transition(new StateTapeSymbolPair("s3", "B"), new StateTapeSymbolPair("s0", "a"), 1));
trans.add(new Transition(new StateTapeSymbolPair("se", "a"), new StateTapeSymbolPair("se", "a"), -1));
trans.add(new Transition(new StateTapeSymbolPair("se", "*"), new StateTapeSymbolPair("see", "*"), 1));
machine = new UTM(trans, term, init, blank);
machine.initializeTape("babbababaa");
System.out.println("Output (sort): " + machine.runTM() + "\n");
}
}

44
Task/Universal-Turing-machine/JavaScript/universal-turing-machine.js Normal file
View file

@ -0,0 +1,44 @@
function tm(d,s,e,i,b,t,... r) {
document.write(d, '<br>')
if (i<0||i>=t.length) return
var re=new RegExp(b,'g')
write('*',s,i,t=t.split(''))
var p={}; r.forEach(e=>((s,r,w,m,n)=>{p[s+'.'+r]={w,n,m:[0,1,-1][1+'RL'.indexOf(m)]}})(... e.split(/[ .:,]+/)))
for (var n=1; s!=e; n+=1) {
with (p[s+'.'+t[i]]) t[i]=w,s=n,i+=m
if (i==-1) i=0,t.unshift(b)
else if (i==t.length) t[i]=b
write(n,s,i,t)
}
document.write('<br>')
function write(n, s, i, t) {
t = t.join('')
t = t.substring(0,i) + '<u>' + t.charAt(i) + '</u>' + t.substr(i+1)
document.write((' '+n).slice(-3).replace(/ /g,'&nbsp;'), ': ', s, ' [', t.replace(re,'&nbsp;'), ']', '<br>')
}
}
tm( 'Unary incrementer',
// s e i b t
'a', 'h', 0, 'B', '111',
// s.r: w, m, n
'a.1: 1, L, a',
'a.B: 1, S, h'
)
tm( 'Unary adder',
1, 0, 0, '0', '1110111',
'1.1: 0, R, 2', // write 0 rigth goto 2
'2.1: 1, R, 2', // while (1) rigth
'2.0: 1, S, 0' // write 1 stay halt
)
tm( 'Three-state busy beaver',
1, 0, 0, '0', '0',
'1.0: 1, R, 2',
'1.1: 1, R, 0',
'2.0: 0, R, 3',
'2.1: 1, R, 2',
'3.0: 1, L, 3',
'3.1: 1, L, 1'
)

85
Task/Universal-Turing-machine/Julia/universal-turing-machine.julia Normal file
View file

@ -0,0 +1,85 @@
import Base.show
@enum Move Left=1 Stay Right
mutable struct MachineState
state::String
tape::Dict{Int, String}
headpos::Int
end
struct Rule
instate::String
s1::String
s2::String
move::Move
outstate::String
end
struct Program
title::String
initial::String
final::String
blank::String
rules::Vector{Rule}
end
const testprograms = [
(Program("Simple incrementer", "q0", "qf", "B",
[Rule("q0", "1", "1", Right, "q0"), Rule("q0", "B", "1", Stay, "qf")]),
Dict(1 =>"1", 2 => "1", 3 => "1"), true),
(Program("Three-state busy beaver", "a", "halt", "0",
[Rule("a", "0", "1", Right, "b"), Rule("a", "1", "1", Left, "c"),
Rule("b", "0", "1", Left, "a"), Rule("b", "1", "1", Right, "b"),
Rule("c", "0", "1", Left, "b"), Rule("c", "1", "1", Stay, "halt")]),
Dict(), true),
(Program("Five-state busy beaver", "A", "H", "0",
[Rule("A", "0", "1", Right, "B"), Rule("A", "1", "1", Left, "C"),
Rule("B", "0", "1", Right, "C"), Rule("B", "1", "1", Right, "B"),
Rule("C", "0", "1", Right, "D"), Rule("C", "1", "0", Left, "E"),
Rule("D", "0", "1", Left, "A"), Rule("D", "1", "1", Left, "D"),
Rule("E", "0", "1", Stay, "H"), Rule("E", "1", "0", Left, "A")]),
Dict(), false)]
function show(io::IO, mstate::MachineState)
ibracket(i, curpos, val) = (i == curpos) ? "[$val]" : " $val "
print(io, rpad("($(mstate.state))", 12))
for i in sort(collect(keys(mstate.tape)))
print(io, " $(ibracket(i, mstate.headpos, mstate.tape[i]))")
end
end
function turing(program, tape, verbose)
println("\n$(program.title)")
verbose && println(" State \tTape [head]\n--------------------------------------------------")
mstate = MachineState(program.initial, tape, 1)
stepcount = 0
while true
if !haskey(mstate.tape, mstate.headpos)
mstate.tape[mstate.headpos] = program.blank
end
verbose && println(mstate)
for rule in program.rules
if rule.instate == mstate.state && rule.s1 == mstate.tape[mstate.headpos]
mstate.tape[mstate.headpos] = rule.s2
if rule.move == Left
mstate.headpos -= 1
elseif rule.move == Right
mstate.headpos += 1
end
mstate.state = rule.outstate
break
end
end
stepcount += 1
if mstate.state == program.final
break
end
end
verbose && println(mstate)
println("Total steps: $stepcount")
end
for (prog, tape, verbose) in testprograms
turing(prog, tape, verbose)
end

172
Task/Universal-Turing-machine/Kotlin/universal-turing-machine.kotlin Normal file
View file

@ -0,0 +1,172 @@
// version 1.2.10
enum class Dir { LEFT, RIGHT, STAY }
class Rule(
val state1: String,
val symbol1: Char,
val symbol2: Char,
val dir: Dir,
val state2: String
)
class Tape(
var symbol: Char,
var left: Tape? = null,
var right: Tape? = null
)
class Turing(
val states: List<String>,
val finalStates: List<String>,
val symbols: CharArray,
val blank: Char,
var state: String,
tapeInput: CharArray,
rules: List<Rule>
) {
var tape: Tape? = null
val transitions = Array(states.size) { arrayOfNulls<Rule>(symbols.size) }
init {
for (i in 0 until tapeInput.size) {
move(Dir.RIGHT)
tape!!.symbol = tapeInput[i]
}
if (tapeInput.size == 0) move(Dir.RIGHT)
while (tape!!.left != null) tape = tape!!.left
for (i in 0 until rules.size) {
val rule = rules[i]
transitions[stateIndex(rule.state1)][symbolIndex(rule.symbol1)] = rule
}
}
private fun stateIndex(state: String): Int {
val i = states.indexOf(state)
return if (i >= 0) i else 0
}
private fun symbolIndex(symbol: Char): Int {
val i = symbols.indexOf(symbol)
return if (i >= 0) i else 0
}
private fun move(dir: Dir) {
val orig = tape
when (dir) {
Dir.RIGHT -> {
if (orig != null && orig.right != null) {
tape = orig.right
}
else {
tape = Tape(blank)
if (orig != null) {
tape!!.left = orig
orig.right = tape
}
}
}
Dir.LEFT -> {
if (orig != null && orig.left != null) {
tape = orig.left
}
else {
tape = Tape(blank)
if (orig != null) {
tape!!.right = orig
orig.left = tape
}
}
}
Dir.STAY -> {}
}
}
fun printState() {
print("%-10s ".format(state))
var t = tape
while (t!!.left != null ) t = t.left
while (t != null) {
if (t == tape) print("[${t.symbol}]")
else print(" ${t.symbol} ")
t = t.right
}
println()
}
fun run(maxLines: Int = 20) {
var lines = 0
while (true) {
printState()
for (finalState in finalStates) {
if (finalState == state) return
}
if (++lines == maxLines) {
println("(Only the first $maxLines lines displayed)")
return
}
val rule = transitions[stateIndex(state)][symbolIndex(tape!!.symbol)]
tape!!.symbol = rule!!.symbol2
move(rule.dir)
state = rule.state2
}
}
}
fun main(args: Array<String>) {
println("Simple incrementer")
Turing(
states = listOf("q0", "qf"),
finalStates = listOf("qf"),
symbols = charArrayOf('B', '1'),
blank = 'B',
state = "q0",
tapeInput = charArrayOf('1', '1', '1'),
rules = listOf(
Rule("q0", '1', '1', Dir.RIGHT, "q0"),
Rule("q0", 'B', '1', Dir.STAY, "qf")
)
).run()
println("\nThree-state busy beaver")
Turing(
states = listOf("a", "b", "c", "halt"),
finalStates = listOf("halt"),
symbols = charArrayOf('0', '1'),
blank = '0',
state = "a",
tapeInput = charArrayOf(),
rules = listOf(
Rule("a", '0', '1', Dir.RIGHT, "b"),
Rule("a", '1', '1', Dir.LEFT, "c"),
Rule("b", '0', '1', Dir.LEFT, "a"),
Rule("b", '1', '1', Dir.RIGHT, "b"),
Rule("c", '0', '1', Dir.LEFT, "b"),
Rule("c", '1', '1', Dir.STAY, "halt")
)
).run()
println("\nFive-state two-symbol probable busy beaver")
Turing(
states = listOf("A", "B", "C", "D", "E", "H"),
finalStates = listOf("H"),
symbols = charArrayOf('0', '1'),
blank = '0',
state = "A",
tapeInput = charArrayOf(),
rules = listOf(
Rule("A", '0', '1', Dir.RIGHT, "B"),
Rule("A", '1', '1', Dir.LEFT, "C"),
Rule("B", '0', '1', Dir.RIGHT, "C"),
Rule("B", '1', '1', Dir.RIGHT, "B"),
Rule("C", '0', '1', Dir.RIGHT, "D"),
Rule("C", '1', '0', Dir.LEFT, "E"),
Rule("D", '0', '1', Dir.LEFT, "A"),
Rule("D", '1', '1', Dir.LEFT, "D"),
Rule("E", '0', '1', Dir.STAY, "H"),
Rule("E", '1', '0', Dir.LEFT, "A")
)
).run()
}

129
Task/Universal-Turing-machine/Lambdatalk/universal-turing-machine.lambdatalk Normal file
View file

@ -0,0 +1,129 @@
{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]

84
Task/Universal-Turing-machine/Lua/universal-turing-machine.lua Normal file
View file

@ -0,0 +1,84 @@
-- Machine definitions
local incrementer = {
name = "Simple incrementer",
initState = "q0",
endState = "qf",
blank = "B",
rules = {
{"q0", "1", "1", "right", "q0"},
{"q0", "B", "1", "stay", "qf"}
}
}
local threeStateBB = {
name = "Three-state busy beaver",
initState = "a",
endState = "halt",
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"}
}
}
local fiveStateBB = {
name = "Five-state busy beaver",
initState = "A",
endState = "H",
blank = "0",
rules = {
{"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"}
}
}
-- Display a representation of the tape and machine state on the screen
function show (state, headPos, tape)
local leftEdge = 1
while tape[leftEdge - 1] do leftEdge = leftEdge - 1 end
io.write(" " .. state .. "\t| ")
for pos = leftEdge, #tape do
if pos == headPos then io.write("[" .. tape[pos] .. "] ") else io.write(" " .. tape[pos] .. " ") end
end
print()
end
-- Simulate a turing machine
function UTM (machine, tape, countOnly)
local state, headPos, counter = machine.initState, 1, 0
print("\n\n" .. machine.name)
print(string.rep("=", #machine.name) .. "\n")
if not countOnly then print(" State", "| Tape [head]\n---------------------") end
repeat
if not tape[headPos] then tape[headPos] = machine.blank end
if not countOnly then show(state, headPos, tape) end
for _, rule in ipairs(machine.rules) do
if rule[1] == state and rule[2] == tape[headPos] then
tape[headPos] = rule[3]
if rule[4] == "left" then headPos = headPos - 1 end
if rule[4] == "right" then headPos = headPos + 1 end
state = rule[5]
break
end
end
counter = counter + 1
until state == machine.endState
if countOnly then print("Steps taken: " .. counter) else show(state, headPos, tape) end
end
-- Main procedure
UTM(incrementer, {"1", "1", "1"})
UTM(threeStateBB, {})
UTM(fiveStateBB, {}, "countOnly")

154
Task/Universal-Turing-machine/M2000-Interpreter/universal-turing-machine.m2000 Normal file
View file

@ -0,0 +1,154 @@
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

49
Task/Universal-Turing-machine/MATLAB/universal-turing-machine.m Normal file
View file

@ -0,0 +1,49 @@
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

18
Task/Universal-Turing-machine/Mathematica/universal-turing-machine-1.math Normal file
View file

@ -0,0 +1,18 @@
left = 1; right = -1; stay = 0;
cmp[s_] := ToExpression[StringSplit[s, ","]];
utm[rules_, initial_, head_] :=
Module[{tape = initial, rh = head, n = 1},
Clear[nxt];
nxt[state_, field_] :=
nxt[state, field] = Position[rules, {rules[[state, 5]], field, _, _, _}][[1, 1]];
n = Position[rules, {rules[[n, 1]], BitGet[tape, rh], _, _, _}][[1,1]];
While[rules[[n, 4]] != 0,
If[rules[[n, 3]] != BitGet[tape, rh],
If[rules[[n, 3]] == 1, tape = BitSet[tape, rh],
tape = BitClear[tape, rh]]];
rh = rh + rules[[n, 4]];
If[rh < 0, rh = 0; tape = 2*tape];
n = nxt[n, BitGet[tape, rh]];
]; {tape, rh}
];
];

18
Task/Universal-Turing-machine/Mathematica/universal-turing-machine-2.math Normal file
View file

@ -0,0 +1,18 @@
printMachine[tape_,pos_]:=(mach=IntegerString[tape,2];
ptr=StringReplace[mach,{"0"-> " ","1"->" "}];
Print[mach];Print[StringInsert[ptr,"^",StringLength[ptr]-pos]];);
simpleIncr={"q0,1,1,right,q0","q0,B,1,stay,qf"};
simpleIncr=Map[cmp,simpleIncr]/.B->0;
fin=utm[simpleIncr,7,2];
printMachine[fin[[1]],fin[[2]]];
busyBeaver3S={
"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"};
fin=utm[Map[cmp,busyBeaver3S],0,0];
printMachine[fin[[1]],fin[[2]]];

16
Task/Universal-Turing-machine/Mathematica/universal-turing-machine-3.math Normal file
View file

@ -0,0 +1,16 @@
probable5S={
"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"};
fin=utm[Map[cmp,probable5S],0,0];
]
fin[[1]]//N
3.254757786465838*10^3698

58
Task/Universal-Turing-machine/Mercury/universal-turing-machine-1.mercury Normal file
View file

@ -0,0 +1,58 @@
:- module turing.
:- interface.
:- import_module list.
:- import_module set.
:- type config(State, Symbol)
---> config(initial_state :: State,
halting_states :: set(State),
blank :: Symbol ).
:- type action ---> left ; stay ; right.
:- func turing(config(State, Symbol),
pred(State, Symbol, Symbol, action, State),
list(Symbol)) = list(Symbol).
:- mode turing(in,
pred(in, in, out, out, out) is semidet,
in) = out is det.
:- implementation.
:- import_module pair.
:- import_module require.
turing(Config@config(Start, _, _), Rules, Input) = Output :-
(Left-Right) = perform(Config, Rules, Start, ([]-Input)),
Output = append(reverse(Left), Right).
:- func perform(config(State, Symbol),
pred(State, Symbol, Symbol, action, State),
State, pair(list(Symbol))) = pair(list(Symbol)).
:- mode perform(in, pred(in, in, out, out, out) is semidet,
in, in) = out is det.
perform(Config@config(_, Halts, Blank), Rules, State,
Input@(LeftInput-RightInput)) = Output :-
symbol(RightInput, Blank, RightNew, Symbol),
( set.member(State, Halts) ->
Output = Input
; Rules(State, Symbol, NewSymbol, Action, NewState) ->
NewLeft = pair(LeftInput, [NewSymbol|RightNew]),
NewRight = action(Action, Blank, NewLeft),
Output = perform(Config, Rules, NewState, NewRight)
;
error("an impossible state has apparently become possible") ).
:- pred symbol(list(Symbol), Symbol, list(Symbol), Symbol).
:- mode symbol(in, in, out, out) is det.
symbol([], Blank, [], Blank).
symbol([Sym|Rem], _, Rem, Sym).
:- func action(action, State, pair(list(State))) = pair(list(State)).
action(left, Blank, ([]-Right)) = ([]-[Blank|Right]).
action(left, _, ([Left|Lefts]-Rights)) = (Lefts-[Left|Rights]).
action(stay, _, Tape) = Tape.
action(right, Blank, (Left-[])) = ([Blank|Left]-[]).
action(right, _, (Left-[Right|Rights])) = ([Right|Left]-Rights).

17
Task/Universal-Turing-machine/Mercury/universal-turing-machine-2.mercury Normal file
View file

@ -0,0 +1,17 @@
:- type incrementer_states ---> a ; halt.
:- type incrementer_symbols ---> b ; '1'.
:- func incrementer_config = config(incrementer_states, incrementer_symbols).
incrementer_config = config(a, % the initial state
set([halt]), % the set of halting states
b). % the blank symbol
:- pred incrementer(incrementer_states::in,
incrementer_symbols::in,
incrementer_symbols::out,
action::out,
incrementer_states::out) is semidet.
incrementer(a, '1', '1', right, a).
incrementer(a, b, '1', stay, halt).
TapeOut = turing(incrementer_config, incrementer, [1, 1, 1]).

21
Task/Universal-Turing-machine/Mercury/universal-turing-machine-3.mercury Normal file
View file

@ -0,0 +1,21 @@
:- type busy_beaver_states ---> a ; b ; c ; halt.
:- type busy_beaver_symbols ---> '0' ; '1'.
:- func busy_beaver_config = config(busy_beaver_states, busy_beaver_symbols).
busy_beaver_config = config(a, % initial state
set([halt]), % set of terminating states
'0'). % blank symbol
:- pred busy_beaver(busy_beaver_states::in,
busy_beaver_symbols::in,
busy_beaver_symbols::out,
action::out,
busy_beaver_states::out) is semidet.
busy_beaver(a, '0', '1', right, b).
busy_beaver(a, '1', '1', left, c).
busy_beaver(b, '0', '1', left, a).
busy_beaver(b, '1', '1', right, b).
busy_beaver(c, '0', '1', left, b).
busy_beaver(c, '1', '1', stay, halt).
TapeOut = turing(busy_beaver_config, busy_beaver, []).

373
Task/Universal-Turing-machine/NetLogo/universal-turing-machine.netlogo Normal file
View file

@ -0,0 +1,373 @@
;; "A Turing Turtle": a Turing Machine implemented in NetLogo
;; by Dan Dewey 1/16/2016
;;
;; This NetLogo code implements a Turing Machine, see, e.g.,
;; http://en.wikipedia.org/wiki/Turing_machine
;; The Turing machine fits nicely into the NetLogo paradigm in which
;; there are agents (aka the turtles), that move around
;; in a world of "patches" (2D cells).
;; Here, a single agent represents the Turing machine read/write head
;; and the patches represent the Turing tape values via their colors.
;; The 2D array of patches is treated as a single long 1D tape in an
;; obvious way.
;; This program is presented as a NetLogo example on the page:
;; http://rosettacode.org/wiki/Universal_Turing_machine
;; This file may be larger than others on that page, note however
;; that I include many comments in the code and I have made no
;; effort to 'condense' the code, prefering clarity over compactness.
;; A demo and discussion of this program is on the web page:
;; http://sites.google.com/site/dan3deweyscspaimsportfolio/extra-turing-machine
;; The Copy example machine was taken from:
;; http://en.wikipedia.org/wiki/Turing_machine_examples
;; The "Busy Beaver" machines encoded below were taken from:
;; http://www.logique.jussieu.fr/~michel/ha.html
;; The implementation here allows 3 symbols (blank, 0, 1) on the tape
;; and 3 head motions (left, stay, right).
;; The 2D world is nominally set to be 29x29, going from (-14,-14) to
;; (14,14) from lower left to upper right and with (0,0) at the center.
;; This gives a total Turing tape length of 29^2 = 841 cells, sufficient for the
;; "Lazy" Beaver 5,2 example.
;; Since the max-pxcor variable is used in the code below (as opposed to
;; a hard-coded number), the effective tape size can be changed by
;; changing the size of the 2D world with the Settings... button on the interface.
;; The "Info" tab of the NetLogo interface contains some further comments.
;; - - - - - - -
;; - - - - - - - - - - - Global/Agent variables
;; These three 2D arrays (lists of lists) encode the Turing Machine rules:
;; WhatToWrite: -1 (Blank), 0, 1
;; HowToMove: -1 (left), 0(stay), 1 (right)
;; NextState: 0 to N-1, negative value goes to a halt state.
;; The above are a function of the current state and the current tape (patch) value.
;; MachineState is used by the turtle to pass the current state of the Turing machine
;; (or the halt code) to the observer.
globals [ WhatToWrite HowToMove NextState MachineState
;; some other golobals of secondary importance...
;; set different patch colors to record the Turing tape values
BlankColor ZeroColor OneColor
;; a delay constant to slow down the operation
RealTimePerTick ]
;; We'll have one turtle which is the Turing machine read/write head
;; it will keep track of the current Turing state in its own MyState value
turtles-own [ MyState ]
;; - - - - - - - - - - -
to Setup ;; sets up the world
clear-all ;; clears the world first
;; Try to not have (too many) ad hoc numbers in the code,
;; collect and set various values here especially if they might be used in multiple places:
;; The colors for Blank, Zero and One : (user can can change as desired)
set BlankColor 2 ;; dark gray
set OneColor green
set ZeroColor red
;; slow it down for the humans to watch
set RealTimePerTick 0.2 ;; have simulation go at nice realtime speed
create-turtles 1 ;; create the one Turing turtle
[ ;; set default parameters
set size 2 ;; set a nominal size
set color yellow ;; color of border
;; set the starting location, some Turing programs will adjust this if needed:
setxy 0 0 ;; -1 * max-pxcor -1 * max-pxcor
set shape "square2empty" ;; edited version of "square 2" to have clear in middle
;; set the starting state - always 0
set MyState 0
set MachineState 0 ;; the turtle will update this global value from now on
]
;; Define the Turing machine rules with 2D lists.
;; Based on the selection made on interface panel, setting the string Turing_Program_Selection.
;; This routine has all the Turing 'programs' in it - it's at the very bottom of this file.
LoadTuringProgram
;; the environment, e.g. the Turing tape
ask patches
[
;; all patches are set to the blank color
set pcolor BlankColor
]
;; keep track of time; each tick is a Turing step
reset-ticks
end
;; - - - - - - - - - - - - - - - -
to Go ;; this repeatedly does steps
;; The turtle does the main work
ask turtles
[
DoOneStep
wait RealTimePerTick
]
tick
;; The Turing turtle will die if it tries to go beyond the cells,
;; in that case (no turtles left) we'll stop.
;; Also stop if the MachineState has been set to a negative number (a halt state).
if ((count turtles = 0) or (MachineState < 0))
[ stop ]
end
to DoOneStep
;; have the turtle do one Turing step
;; First, 'read the tape', i.e., based on the patch color here:
let tapeValue GetTapeValue
;; using the tapeValue and MyState, get the desired actions here:
;; (the item commands extract the appropriate value from the list-of-lists)
let myWrite item (tapeValue + 1) (item MyState WhatToWrite)
let myMove item (tapeValue + 1) (item MyState HowToMove)
let myNextState item (tapeValue + 1) (item MyState NextState)
;; Write to the tape as appropriate
SetTapeValue myWrite
;; Move as appropriate
if (myMove = 1) [MoveForward]
if (myMove = -1) [MoveBackward]
;; Go to the next state; check if it is a halt state.
;; Update the global MachineState value
set MachineState myNextState
ifelse (myNextState < 0)
[
;; It's a halt state. The negative MachineState will signal the stop.
;; Go back to the starting state so it can be re-run if desired.
set MyState 0]
[
;; Not a halt state, so change to the desired next state
set MyState myNextState
]
end
to MoveForward
;; move the turtle forward one cell, including line wrapping.
set heading 90
ifelse (xcor = max-pxcor)
[set xcor -1 * max-pxcor
;; and go up a row if possible... otherwise die
ifelse ycor = max-pxcor
[ die ] ;; tape too short - a somewhat crude end of things ;-)
[set ycor ycor + 1]
]
[jump 1]
end
to MoveBackward
;; move the turtle backward one cell, including line-wrapping.
set heading -90
ifelse (xcor = -1 * max-pxcor)
[
set xcor max-pxcor
;; and go down a row... or die
ifelse ycor = -1 * max-pxcor
[ die ] ;; tape too short - a somewhat crude end of things ;-)
[set ycor ycor - 1]
]
[jump 1]
end
to-report GetTapeValue
;; report the tape color equivalent value
if (pcolor = ZeroColor) [report 0]
if (pcolor = OneColor) [report 1]
report -1
end
to SetTapeValue [ value ]
;; write the appropriate color on the tape
ifelse (value = 1)
[set pcolor OneColor]
[ ifelse (value = 0)
[set pcolor ZeroColor][set pcolor BlankColor]]
end
;; - - - - - OK, here are the data for the various Turing programs...
;; Note that besdes settting the rules (array values) these sections can also
;; include commands to clear the tape, position the r/w head, adjust wait time, etc.
to LoadTuringProgram
;; A template of the rules structure: a list of lists
;; E.g. values are given for States 0 to 4, when looking at Blank, Zero, One:
;; For 2-symbol machines use Blank(-1) and One(1) and ignore the middle values (never see zero).
;; Normal Halt will be state -1, the -9 default shows an unexpected halt.
;; state 0 state 1 state 2 state 3 state 4
set WhatToWrite (list (list -1 0 1) (list -1 0 1) (list -1 0 1) (list -1 0 1) (list -1 0 1) )
set HowToMove (list (list 0 0 0) (list 0 0 0) (list 0 0 0) (list 0 0 0) (list 0 0 0) )
set NextState(list (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) )
;; Fill the rules based on the selected case
if (Turing_Program_Selection = "Simple Incrementor")
[
;; simple Incrementor - this is from the RosettaCode Universal Turing Machine page - very simple!
set WhatToWrite (list (list 1 0 1) )
set HowToMove (list (list 0 0 1) )
set NextState (list (list -1 -9 0) )
]
;; Fill the rules based on the selected case
if (Turing_Program_Selection = "Incrementor w/Return")
[
;; modified Incrementor: it returns to the first 1 on the left.
;; This version allows the "Copy Ones to right" program to directly follow it.
;; move right append one back to beginning
set WhatToWrite (list (list -1 0 1) (list 1 0 1) (list -1 0 1) )
set HowToMove (list (list 1 0 1) (list 0 0 1) (list 1 0 -1) )
set NextState (list (list 1 -9 1) (list 2 -9 1) (list -1 -9 2) )
]
;; Fill the rules based on the selected case
if (Turing_Program_Selection = "Copy Ones to right")
[
;; "Copy" from Wiki "Turing machine examples" page; slight mod so that it ends on first 1
;; of the copy allowing Copy to be re-executed to create another copy.
;; Has 5 states and uses Blank and 1 to make a copy of a string of ones;
;; this can be run after runs of the "Incrementor w/Return".
;; state 0 state 1 state 2 state 3 state 4
set WhatToWrite (list (list -1 0 -1) (list -1 0 1) (list 1 0 1) (list -1 0 1) (list 1 0 1) )
set HowToMove (list (list 1 0 1) (list 1 0 1) (list -1 0 1) (list -1 0 -1) (list 1 0 -1) )
set NextState (list (list -1 -9 1) (list 2 -9 1) (list 3 -9 2) (list 4 -9 3) (list 0 -9 4) )
]
;; Fill the rules based on the selected case
if (Turing_Program_Selection = "Binary Counter")
[
;; Count in binary - can start on a blank space.
;; States: start carry-1 back-to-beginning
set WhatToWrite (list (list 1 1 0) (list 1 1 0) (list -1 0 1) )
set HowToMove (list (list 0 0 -1) (list 0 0 -1) (list -1 1 1) )
set NextState (list (list -1 -1 1) (list 2 2 1) (list -1 2 2) )
;; Select line above from these two:
;; can either count by 1 each time it is run:
;; set NextState (list (list -1 -1 1) (list 2 2 1) (list -1 2 2) )
;; or count forever once started:
;; set NextState (list (list 0 0 1) (list 2 2 1) (list 0 2 2) )
set RealTimePerTick 0.2
]
if (Turing_Program_Selection = "Busy-Beaver 3-State, 2-Sym")
[
;; from the RosettaCode.org Universal Turing Machine page
;; state name: a b c
set WhatToWrite (list (list 1 0 1) (list 1 0 1) (list 1 0 1) (list -1 0 1) (list -1 0 1) )
set HowToMove (list (list 1 0 -1) (list -1 0 1) (list -1 0 0) (list 0 0 0) (list 0 0 0) )
set NextState (list (list 1 -9 2) (list 0 -9 1) (list 1 -9 -1) (list -9 -9 -9) (list -9 -9 -9) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
]
;; should output 13 ones and take 107 steps to do it...
if (Turing_Program_Selection = "Busy-Beaver 4-State, 2-Sym")
[
;; from the RosettaCode.org Universal Turing Machine page
;; state name: A B C D
set WhatToWrite (list (list 1 0 1) (list 1 0 -1) (list 1 0 1) (list 1 0 -1) (list -1 0 1) )
set HowToMove (list (list 1 0 -1) (list -1 0 -1) (list 1 0 -1) (list 1 0 1) (list 0 0 0) )
set NextState (list (list 1 -9 1) (list 0 -9 2) (list -1 -9 3) (list 3 -9 0) (list -9 -9 -9) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
]
;; This takes 38 steps to write 9 ones/zeroes
if (Turing_Program_Selection = "Busy-Beaver 2-State, 3-Sym")
[
;; A B
set WhatToWrite (list (list 0 1 0) (list 1 1 0) (list -1 0 1) (list -1 0 1) (list -1 0 1) )
set HowToMove (list (list 1 -1 1) (list -1 1 -1) (list 0 0 0) (list 0 0 0) (list 0 0 0) )
set NextState(list (list 1 1 -1) (list 0 1 1) (list -9 -9 -9) (list -9 -9 -9) (list -9 -9 -9) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
]
;; This only makes 501 ones and stops after 134,467 steps -- it does do that !!!
if (Turing_Program_Selection = "Lazy-Beaver 5-State, 2-Sym")
[
;; from the RosettaCode.org Universal Turing Machine page
;; state name: A0 B1 C2 D3 E4
set WhatToWrite (list (list 1 0 -1) (list 1 0 1) (list 1 0 -1) (list -1 0 1) (list 1 0 1) )
set HowToMove (list (list 1 0 -1) (list 1 0 1) (list -1 0 1) (list 1 0 1) (list -1 0 1) )
set NextState (list (list 1 -9 2) (list 2 -9 3) (list 0 -9 1) (list 4 -9 -1) (list 2 -9 0) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
;; Looks like it goes much more forward than back on the tape
;; so start the head just a row from the bottom:
ask turtles [setxy 0 -1 * max-pxcor + 1]
;; and go faster
set RealTimePerTick 0.02
]
;; The rest have large outputs and run for a long time, so I haven't confirmed
;; that they work as advertised...
;; This is the 5,2 record holder: 4098 ones in 47,176,870 steps.
;; With max-pxcor of 14 and offset r/w head start (below), this will
;; run off the tape at about 150,000+steps...
if (Turing_Program_Selection = "Busy-Beaver 5-State, 2-Sym")
[
;; from the RosettaCode.org Universal Turing Machine page
;; state name: A B C D E
set WhatToWrite (list (list 1 0 1) (list 1 0 1) (list 1 0 -1) (list 1 0 1) (list 1 0 -1) )
set HowToMove (list (list 1 0 -1) (list 1 0 1) (list 1 0 -1) (list -1 0 -1) (list 1 0 -1) )
set NextState (list (list 1 -9 2) (list 2 -9 1) (list 3 -9 4) (list 0 -9 3) (list -1 -9 0) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
;; Writes more backward than forward, so start a few rows from the top:
ask turtles [setxy 0 max-pxcor - 3]
;; and go faster
set RealTimePerTick 0.02
]
if (Turing_Program_Selection = "Lazy-Beaver 3-State, 3-Sym")
[
;; This should write 5600 ones/zeros and take 29,403,894 steps.
;; Ran it to 175,000+ steps and only covered 1/2 of the cells (w/max-pxcor = 14)...
;; state name: A B C
set WhatToWrite (list (list 0 1 0) (list 1 -1 0) (list 0 1 0) (list -1 0 1) (list -1 0 1) )
set HowToMove (list (list 1 1 -1) (list -1 1 1) (list 1 -1 1) (list 0 0 0) (list 0 0 0) )
set NextState (list (list 1 0 0) (list 2 2 1) (list -1 0 1) (list -9 -9 -9) (list -9 -9 -9) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
;; It goes much more forward than back on the tape
;; so start the head just a row from the bottom:
ask turtles [setxy 0 -1 * max-pxcor + 1]
;; and go faster
set RealTimePerTick 0.02
]
if (Turing_Program_Selection = "Busy-Beaver 3-State, 3-Sym")
[
;; This should write 374,676,383 ones/zeros and take 119,112,334,170,342,540 (!!!) steps.
;; Rn it to ~ 175,000 steps covering about 2/3 of the max-pxcor=14 cells.
;; state name: A B C
set WhatToWrite (list (list 0 1 0) (list -1 1 0) (list 0 0 0) (list -1 0 1) (list -1 0 1) )
set HowToMove (list (list 1 -1 -1) (list -1 1 -1) (list 1 1 1) (list 0 0 0) (list 0 0 0) )
set NextState (list (list 1 0 2) (list 0 1 1) (list -1 0 2) (list -9 -9 -9) (list -9 -9 -9) )
;; Clear the tape
ask Patches [set pcolor BlankColor]
;; Writes more backward than forward, so start a rowish from the top:
ask turtles [setxy 0 max-pxcor - 1]
;; and go faster
set RealTimePerTick 0.02
]
;; in all cases reset the machine state to 0:
ask turtles [set MyState 0]
set MachineState 0
;; and the ticks
reset-ticks
end

75
Task/Universal-Turing-machine/Nim/universal-turing-machine.nim Normal file
View file

@ -0,0 +1,75 @@
import strutils, tables
proc runUTM(state, halt, blank: string, tape: seq[string] = @[],
rules: seq[seq[string]]) =
var
st = state
pos = 0
tape = tape
rulesTable: Table[tuple[s0, v0: string], tuple[v1, dr, s1: string]]
if tape.len == 0: tape = @[blank]
if pos < 0: pos += tape.len
assert pos in 0..tape.high
for r in rules:
assert r.len == 5
rulesTable[(r[0], r[1])] = (r[2], r[3], r[4])
while true:
stdout.write st, '\t'
for i, v in tape:
stdout.write if i == pos: '[' & v & ']' else: ' ' & v & ' '
echo()
if st == halt: break
if not rulesTable.hasKey((st, tape[pos])): break
let (v1, dr, s1) = rulesTable[(st, tape[pos])]
tape[pos] = v1
if dr == "left":
if pos > 0: dec pos
else: tape.insert blank
if dr == "right":
inc pos
if pos >= tape.len: tape.add blank
st = s1
echo "incr machine\n"
runUTM(halt = "qf",
state = "q0",
tape = "1 1 1".split,
blank = "B",
rules = @["q0 1 1 right q0".splitWhitespace,
"q0 B 1 stay qf".splitWhitespace])
echo "\nbusy beaver\n"
runUTM(halt = "halt",
state = "a",
blank = "0",
rules = @["a 0 1 right b".splitWhitespace,
"a 1 1 left c".splitWhitespace,
"b 0 1 left a".splitWhitespace,
"b 1 1 right b".splitWhitespace,
"c 0 1 left b".splitWhitespace,
"c 1 1 stay halt".splitWhitespace])
echo "\nsorting test\n"
runUTM(halt = "STOP",
state = "A",
blank = "0",
tape = "2 2 2 1 2 2 1 2 1 2 1 2 1 2".split,
rules = @["A 1 1 right A".splitWhitespace,
"A 2 3 right B".splitWhitespace,
"A 0 0 left E".splitWhitespace,
"B 1 1 right B".splitWhitespace,
"B 2 2 right B".splitWhitespace,
"B 0 0 left C".splitWhitespace,
"C 1 2 left D".splitWhitespace,
"C 2 2 left C".splitWhitespace,
"C 3 2 left E".splitWhitespace,
"D 1 1 left D".splitWhitespace,
"D 2 2 left D".splitWhitespace,
"D 3 1 right A".splitWhitespace,
"E 1 1 left E".splitWhitespace,
"E 0 0 right STOP".splitWhitespace])

152
Task/Universal-Turing-machine/PHL/universal-turing-machine.phl Normal file
View file

@ -0,0 +1,152 @@
module turing;
extern printf;
struct @Command {
field @Integer tape {get:tape,set:stape};
field @Integer move {get:move,set:smove};
field @Integer next {get:next,set:snext};
@Command init(@Integer tape, @Integer move, @Integer next) [
this.stape(tape);
this.smove(move);
this.snext(next);
return this;
]
};
doc 2 dimansional array structure;
struct @Rules {
field @Integer maxstates { get: maxstates, set: smaxstates };
field @Integer maxvalue { get: maxvalue, set: smaxvalue };
field @Array<@Array<@Command> > table {get: t, set: st};
@Rules init(@Integer states, @Integer values)
[
this.smaxstates(states);
this.smaxvalue(values);
this.st(new @Array<@Array<@Command> >.init(states));
return this;
]
@Void setRule(@Integer state, @Integer tape, @Command command)
[
if (null == this::t.get(state)) {
this::t.set(state, new @Array<@Command>.init(this::maxvalue));
}
this::t.get(state).set(tape, command);
]
@Command getRule(@Integer state, @Integer tape)
[
return this::t.get(state).get(tape);
]
};
@Void emulateTuring(@Rules rules, @Integer start, @Integer stop, @Array<@Integer> tape, @Integer blank) [
var tapepointer = 0;
var state = start;
doc output;
printf("Tape\tState\n");
while (state != stop) {
doc add more cells to the tape;
if (tapepointer == tape::size) tape.add(blank);
if (tapepointer == 0-1) { tape = (new @Array<@Integer>..blank).addAll(tape); tapepointer = 0; }
doc output;
for (var i = 0; i < tape::size; i=i+1) {
printf("%i", tape.get(i));
}
printf("\t%i\n", state);
for (var i = 0; i < tapepointer; i=i+1) {
printf(" ");
}
printf("^\n");
doc the value of the current cell;
var tapeval = tape.get(tapepointer);
doc the current state;
var command = rules.getRule(state, tapeval);
tape.set(tapepointer, command::tape);
tapepointer = tapepointer + command::move;
state = command::next;
}
doc output;
for (var i = 0; i < tape::size; i=i+1) {
printf("%i", tape.get(i));
}
printf("\t%i\n", state);
for (var i = 0; i < tapepointer; i=i+1) {
printf(" ");
}
printf("^\n");
]
@Integer main [
doc incrementer;
doc 2 states, 2 symbols;
var rules = new @Rules.init(2, 2);
doc q0, 1 -> 1, right, q0;
doc q0, B -> 1, stay, qf;
rules.setRule(0, 1, new @Command.init(1, 1, 0));
rules.setRule(0, 0, new @Command.init(1, 0, 1));
doc tape = [1, 1, 1];
var tape = new @Array<@Integer>..1..1..1;
doc start turing machine;
emulateTuring(rules, 0, 1, tape, 0);
doc ---------------------------------------------------;
doc three state busy beaver;
doc 4 states, 2 symbols;
rules = new @Rules.init(4, 2);
doc 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
;
doc a = 0,
b = 1,
c = 2,
halt = 3;
rules.setRule(0, 0, new @Command.init(1, 1, 1));
rules.setRule(0, 1, new @Command.init(1, 0-1, 2));
rules.setRule(1, 0, new @Command.init(1, 0-1, 0));
rules.setRule(1, 1, new @Command.init(1, 1, 1));
rules.setRule(2, 0, new @Command.init(1, 0-1, 1));
rules.setRule(2, 1, new @Command.init(1, 0, 3));
doc tape = [];
tape = new @Array<@Integer>;
doc start turing machine;
emulateTuring(rules, 0, 3, tape, 0);
return 0;
]

83
Task/Universal-Turing-machine/Perl/universal-turing-machine.pl Normal file
View file

@ -0,0 +1,83 @@
use strict;
use warnings;
sub run_utm {
my %o = @_;
my $st = $o{state} // die "init head state undefined";
my $blank = $o{blank} // die "blank symbol undefined";
my @rules = @{$o{rules}} or die "rules undefined";
my @tape = $o{tape} ? @{$o{tape}} : ($blank);
my $halt = $o{halt};
my $pos = $o{pos} // 0;
$pos += @tape if $pos < 0;
die "bad init position" if $pos >= @tape || $pos < 0;
step: while (1) {
print "$st\t";
for (0 .. $#tape) {
my $v = $tape[$_];
print $_ == $pos ? "[$v]" : " $v ";
}
print "\n";
last if $st eq $halt;
for (@rules) {
my ($s0, $v0, $v1, $dir, $s1) = @$_;
next unless $s0 eq $st and $tape[$pos] eq $v0;
$tape[$pos] = $v1;
if ($dir eq 'left') {
if ($pos == 0) { unshift @tape, $blank}
else { $pos-- }
} elsif ($dir eq 'right') {
push @tape, $blank if ++$pos >= @tape
}
$st = $s1;
next step;
}
die "no matching rules";
}
}
print "incr machine\n";
run_utm halt=>'qf',
state=>'q0',
tape=>[1,1,1],
blank=>'B',
rules=>[[qw/q0 1 1 right q0/],
[qw/q0 B 1 stay qf/]];
print "\nbusy beaver\n";
run_utm halt=>'halt',
state=>'a',
blank=>'0',
rules=>[[qw/a 0 1 right b/],
[qw/a 1 1 left c/],
[qw/b 0 1 left a/],
[qw/b 1 1 right b/],
[qw/c 0 1 left b/],
[qw/c 1 1 stay halt/]];
print "\nsorting test\n";
run_utm halt=>'STOP',
state=>'A',
blank=>'0',
tape=>[qw/2 2 2 1 2 2 1 2 1 2 1 2 1 2/],
rules=>[[qw/A 1 1 right A/],
[qw/A 2 3 right B/],
[qw/A 0 0 left E/],
[qw/B 1 1 right B/],
[qw/B 2 2 right B/],
[qw/B 0 0 left C/],
[qw/C 1 2 left D/],
[qw/C 2 2 left C/],
[qw/C 3 2 left E/],
[qw/D 1 1 left D/],
[qw/D 2 2 left D/],
[qw/D 3 1 right A/],
[qw/E 1 1 left E/],
[qw/E 0 0 right STOP/]];

100
Task/Universal-Turing-machine/Phix/universal-turing-machine.phix Normal file
View file

@ -0,0 +1,100 @@
(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>
<!--

76
Task/Universal-Turing-machine/PicoLisp/universal-turing-machine.l Normal file
View file

@ -0,0 +1,76 @@
# 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)

31
Task/Universal-Turing-machine/Prolog/universal-turing-machine-1.pro Normal file
View file

@ -0,0 +1,31 @@
turing(Config, Rules, TapeIn, TapeOut) :-
call(Config, IS, _, _, _, _),
perform(Config, Rules, IS, {[], TapeIn}, {Ls, Rs}),
reverse(Ls, Ls1),
append(Ls1, Rs, TapeOut).
perform(Config, Rules, State, TapeIn, TapeOut) :-
call(Config, _, FS, RS, B, Symbols),
( memberchk(State, FS) ->
TapeOut = TapeIn
; memberchk(State, RS) ->
{LeftIn, RightIn} = TapeIn,
symbol(RightIn, Symbol, RightRem, B),
memberchk(Symbol, Symbols),
once(call(Rules, State, Symbol, NewSymbol, Action, NewState)),
memberchk(NewSymbol, Symbols),
action(Action, {LeftIn, [NewSymbol|RightRem]}, {LeftOut, RightOut}, B),
perform(Config, Rules, NewState, {LeftOut, RightOut}, TapeOut) ).
symbol([], B, [], B).
symbol([Sym|Rs], Sym, Rs, _).
action(left, {Lin, Rin}, {Lout, Rout}, B) :- left(Lin, Rin, Lout, Rout, B).
action(stay, Tape, Tape, _).
action(right, {Lin, Rin}, {Lout, Rout}, B) :- right(Lin, Rin, Lout, Rout, B).
left([], Rs, [], [B|Rs], B).
left([L|Ls], Rs, Ls, [L|Rs], _).
right(L, [], [B|L], [], B).
right(L, [S|Rs], [S|L], Rs, _).

10
Task/Universal-Turing-machine/Prolog/universal-turing-machine-2.pro Normal file
View file

@ -0,0 +1,10 @@
incrementer_config(IS, FS, RS, B, S) :-
IS = q0, % initial state
FS = [qf], % halting states
RS = [IS], % running states
B = 0, % blank symbol
S = [B, 1]. % valid symbols
incrementer(q0, 1, 1, right, q0).
incrementer(q0, b, 1, stay, qf).
turing(incrementer_config, incrementer, [1, 1, 1], TapeOut).

14
Task/Universal-Turing-machine/Prolog/universal-turing-machine-3.pro Normal file
View file

@ -0,0 +1,14 @@
busy_beaver_config(IS, FS, RS, B, S) :-
IS = 'A', % initial state
FS = ['HALT'], % halting states
RS = [IS, 'B', 'C'], % running states
B = 0, % blank symbol
S = [B, 1]. % valid symbols
busy_beaver('A', 0, 1, right, 'B').
busy_beaver('A', 1, 1, left, 'C').
busy_beaver('B', 0, 1, left, 'A').
busy_beaver('B', 1, 1, right, 'B').
busy_beaver('C', 0, 1, left, 'B').
busy_beaver('C', 1, 1, stay, 'HALT').
turing(busy_beaver_config, busy_beaver, [], TapeOut).

87
Task/Universal-Turing-machine/Python/universal-turing-machine.py Normal file
View file

@ -0,0 +1,87 @@
from __future__ import print_function
def run_utm(
state = None,
blank = None,
rules = [],
tape = [],
halt = None,
pos = 0):
st = state
if not tape: tape = [blank]
if pos < 0: pos += len(tape)
if pos >= len(tape) or pos < 0: raise Error( "bad init position")
rules = dict(((s0, v0), (v1, dr, s1)) for (s0, v0, v1, dr, s1) in rules)
while True:
print(st, '\t', end=" ")
for i, v in enumerate(tape):
if i == pos: print("[%s]" % (v,), end=" ")
else: print(v, end=" ")
print()
if st == halt: break
if (st, tape[pos]) not in rules: break
(v1, dr, s1) = rules[(st, tape[pos])]
tape[pos] = v1
if dr == 'left':
if pos > 0: pos -= 1
else: tape.insert(0, blank)
if dr == 'right':
pos += 1
if pos >= len(tape): tape.append(blank)
st = s1
# EXAMPLES
print("incr machine\n")
run_utm(
halt = 'qf',
state = 'q0',
tape = list("111"),
blank = 'B',
rules = map(tuple,
["q0 1 1 right q0".split(),
"q0 B 1 stay qf".split()]
)
)
print("\nbusy beaver\n")
run_utm(
halt = 'halt',
state = 'a',
blank = '0',
rules = map(tuple,
["a 0 1 right b".split(),
"a 1 1 left c".split(),
"b 0 1 left a".split(),
"b 1 1 right b".split(),
"c 0 1 left b".split(),
"c 1 1 stay halt".split()]
)
)
print("\nsorting test\n")
run_utm(halt = 'STOP',
state = 'A',
blank = '0',
tape = "2 2 2 1 2 2 1 2 1 2 1 2 1 2".split(),
rules = map(tuple,
["A 1 1 right A".split(),
"A 2 3 right B".split(),
"A 0 0 left E".split(),
"B 1 1 right B".split(),
"B 2 2 right B".split(),
"B 0 0 left C".split(),
"C 1 2 left D".split(),
"C 2 2 left C".split(),
"C 3 2 left E".split(),
"D 1 1 left D".split(),
"D 2 2 left D".split(),
"D 3 1 right A".split(),
"E 1 1 left E".split(),
"E 0 0 right STOP".split()]
)
)

44
Task/Universal-Turing-machine/REXX/universal-turing-machine-1.rexx Normal file
View file

@ -0,0 +1,44 @@
/*REXX program executes a Turing machine based on initial state, tape, and rules. */
state = 'q0' /*the initial Turing machine state. */
term = 'qf' /*a state that is used for a halt. */
blank = 'B' /*this character is a "true" blank. */
call Turing_rule 'q0 1 1 right q0' /*define a rule for the Turing machine.*/
call Turing_rule 'q0 B 1 stay qf' /* " " " " " " " */
call Turing_init 1 1 1 /*initialize the tape to some string(s)*/
call TM /*go and invoke the Turning machine. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: !=1; bot=1; top=1; @er= '***error***' /*start at the tape location 1. */
say /*might as well display a blank line. */
do cycle=1 until state==term /*process Turing machine instructions.*/
do k=1 for rules /* " " " rules. */
parse var rule.k rState rTape rWrite rMove rNext . /*pick pieces. */
if state\==rState | @.!\==rTape then iterate /*wrong rule ? */
@.!=rWrite /*right rule; write it ───► the tape. */
if rMove== 'left' then !=!-1 /*Are we moving left? Then subtract 1*/
if rMove=='right' then !=!+1 /* " " " right? " add 1*/
bot=min(bot, !); top=max(top, !) /*find the tape bottom and top. */
state=rNext; iterate cycle /*use this for the next state; and */
end /*k*/
say @er 'unknown state:' state; leave /*oops, we have an unknown state error.*/
end /*cycle*/
$= /*start with empty string (the tape). */
do t=bot to top; _=@.t
if _==blank then _=' ' /*do we need to translate a true blank?*/
$=$ || pad || _ /*construct char by char, maybe pad it.*/
end /*t*/ /* [↑] construct the tape's contents*/
L=length($) /*obtain length of " " " */
if L==0 then $= "[tape is blank.]" /*make an empty tape visible to user.*/
if L>1000 then $=left($, 1000) ... /*truncate tape to 1k bytes, append ···*/
say "tape's contents:" $ /*show the tape's contents (or 1st 1k).*/
say "tape's length: " L /* " " " length. */
say 'Turning machine used ' rules " rules in " cycle ' cycles.'
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
Turing_init: @.=blank; parse arg x; do j=1 for words(x); @.j=word(x,j); end /*j*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
Turing_rule: if symbol('RULES')=="LIT" then rules=0; rules=rules+1
pad=left('', length( word( arg(1),2 ) ) \==1 ) /*padding for rule*/
rule.rules=arg(1); say right('rule' rules, 20) "═══►" rule.rules
return

15
Task/Universal-Turing-machine/REXX/universal-turing-machine-2.rexx Normal file
View file

@ -0,0 +1,15 @@
/*REXX program executes a Turing machine based on initial state, tape, and rules. */
state = 'a' /*the initial Turing machine state. */
term = 'halt' /*a state that is used for a halt. */
blank = 0 /*this character is a "true" blank. */
call Turing_rule 'a 0 1 right b' /*define a rule for the Turing machine.*/
call Turing_rule 'a 1 1 left c' /* " " " " " " " */
call Turing_rule 'b 0 1 left a' /* " " " " " " " */
call Turing_rule 'b 1 1 right b' /* " " " " " " " */
call Turing_rule 'c 0 1 left b' /* " " " " " " " */
call Turing_rule 'c 1 1 stay halt' /* " " " " " " " */
call Turing_init /*initialize the tape to some string(s)*/
call TM /*go and invoke the Turning machine. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙

19
Task/Universal-Turing-machine/REXX/universal-turing-machine-3.rexx Normal file
View file

@ -0,0 +1,19 @@
/*REXX program executes a Turing machine based on initial state, tape, and rules. */
state = 'A' /*initialize the Turing machine state.*/
term = 'H' /*a state that is used for the halt. */
blank = 0 /*this character is a "true" blank. */
call Turing_rule 'A 0 1 right B' /*define a rule for the Turing machine.*/
call Turing_rule 'A 1 1 left C' /* " " " " " " " */
call Turing_rule 'B 0 1 right C' /* " " " " " " " */
call Turing_rule 'B 1 1 right B' /* " " " " " " " */
call Turing_rule 'C 0 1 right D' /* " " " " " " " */
call Turing_rule 'C 1 0 left E' /* " " " " " " " */
call Turing_rule 'D 0 1 left A' /* " " " " " " " */
call Turing_rule 'D 1 1 left D' /* " " " " " " " */
call Turing_rule 'E 0 1 stay H' /* " " " " " " " */
call Turing_rule 'E 1 0 left A' /* " " " " " " " */
call Turing_init /*initialize the tape to some string(s)*/
call TM /*go and invoke the Turning machine. */
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙

23
Task/Universal-Turing-machine/REXX/universal-turing-machine-4.rexx Normal file
View file

@ -0,0 +1,23 @@
/*REXX program executes a Turing machine based on initial state, tape, and rules. */
state = 'A' /*the initial Turing machine state. */
term = 'halt' /*a state that is used for the halt. */
blank = 0 /*this character is a "true" blank. */
call Turing_rule 'A 1 1 right A' /*define a rule for the Turing machine.*/
call Turing_rule 'A 2 3 right B' /* " " " " " " " */
call Turing_rule 'A 0 0 left E' /* " " " " " " " */
call Turing_rule 'B 1 1 right B' /* " " " " " " " */
call Turing_rule 'B 2 2 right B' /* " " " " " " " */
call Turing_rule 'B 0 0 left C' /* " " " " " " " */
call Turing_rule 'C 1 2 left D' /* " " " " " " " */
call Turing_rule 'C 2 2 left C' /* " " " " " " " */
call Turing_rule 'C 3 2 left E' /* " " " " " " " */
call Turing_rule 'D 1 1 left D' /* " " " " " " " */
call Turing_rule 'D 2 2 left D' /* " " " " " " " */
call Turing_rule 'D 3 1 right A' /* " " " " " " " */
call Turing_rule 'E 1 1 left E' /* " " " " " " " */
call Turing_rule 'E 0 0 right halt' /* " " " " " " " */
call Turing_init 1 2 2 1 2 2 1 2 1 2 1 2 1 2 /*initialize the tape to some string(s)*/
call TM /*go and invoke the Turning machine. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙

96
Task/Universal-Turing-machine/Racket/universal-turing-machine-1.rkt Normal file
View file

@ -0,0 +1,96 @@
#lang racket
;;;=============================================================
;;; Due to heavy use of pattern matching we define few macros
;;;=============================================================
(define-syntax-rule (define-m f m ...)
(define f (match-lambda m ... (x x))))
(define-syntax-rule (define-m* f m ...)
(define f (match-lambda** m ...)))
;;;=============================================================
;;; The definition of a functional type Tape,
;;; representing infinite tape with O(1) operations:
;;; put, get, shift-right and shift-left.
;;;=============================================================
(struct Tape (the-left-part ; i-1 i-2 i-3 ...
the-current-record ; i
the-right-part)) ; i+1 i+2 i+3 ...
;; the initial record on the tape
(define-m initial-tape
[(cons h t) (Tape '() h t)])
;; shifts caret to the right
(define (snoc a b) (cons b a))
(define-m shift-right
[(Tape '() '() (cons h t)) (Tape '() h t)] ; left end
[(Tape l x '()) (Tape (snoc l x) '() '())] ; right end
[(Tape l x (cons h t)) (Tape (snoc l x) h t)]) ; general case
;; shifts caret to the left
(define-m flip-tape [(Tape l x r) (Tape r x l)])
(define shift-left
(compose flip-tape shift-right flip-tape))
;; returns the current record on the tape
(define-m get [(Tape _ v _) v])
;; writes to the current position on the tape
(define-m* put
[('() t) t]
[(v (Tape l _ r)) (Tape l v r)])
;; Shows the list representation of the tape (≤ O(n)).
;; A tape is shown as (... a b c (d) e f g ...)
;; where (d) marks the current position of the caret.
(define (revappend a b) (foldl cons b a))
(define-m show-tape
[(Tape '() '() '()) '()]
[(Tape l '() r) (revappend l (cons '() r))]
[(Tape l v r) (revappend l (cons (list v) r))])
;;;-------------------------------------------------------------------
;;; The Turing Machine interpreter
;;;
;; interpretation of output triple for a given tape
(define-m* interprete
[((list v 'right S) tape) (list S (shift-right (put v tape)))]
[((list v 'left S) tape) (list S (shift-left (put v tape)))]
[((list v 'stay S) tape) (list S (put v tape))]
[((list S _) tape) (list S tape)])
;; Runs the program.
;; The initial state is set to start.
;; The initial tape is given as a list of records.
;; The initial position is the leftmost symbol of initial record.
(define (run-turing prog t0 start)
((fixed-point
(match-lambda
[`(,S ,T) (begin
(printf "~a\t~a\n" S (show-tape T))
(interprete (prog `(,S ,(get T))) T))]))
(list start (initial-tape t0))))
;; a general fixed point operator
(define ((fixed-point f) x)
(let F ([x x] [fx (f x)])
(if (equal? x fx)
fx
(F fx (f fx)))))
;; A macro for definition of a Turing-Machines.
;; Transforms to a function which accepts a list of initial
;; tape records as input and returns the tape after stopping.
(define-syntax-rule (Turing-Machine #:start start (a b c d e) ...)
(λ (l)
(displayln "STATE\tTAPE")
((match-lambda [(list _ t) (flatten (show-tape t))])
(run-turing
(match-lambda ['(a b) '(c d e)] ... [x x])
l start))))

4
Task/Universal-Turing-machine/Racket/universal-turing-machine-2.rkt Normal file
View file

@ -0,0 +1,4 @@
(define INC
(Turing-Machine #:start 'q0
[q0 1 1 right q0]
[q0 () 1 stay qf]))

8
Task/Universal-Turing-machine/Racket/universal-turing-machine-3.rkt Normal file
View file

@ -0,0 +1,8 @@
(define ADD1
(Turing-Machine #:start 'Start
[Start 1 1 right Start]
[Start 0 0 right Start]
[Start () () left Add]
[Add 0 1 stay End]
[Add 1 0 left Add]
[Add () 1 stay End]))

8
Task/Universal-Turing-machine/Racket/universal-turing-machine-4.rkt Normal file
View file

@ -0,0 +1,8 @@
(define BEAVER
(Turing-Machine #:start 'a
[a () 1 right b]
[a 1 1 left c]
[b () 1 left a]
[b 1 1 right b]
[c () 1 left b]
[c 1 1 stay halt]))

16
Task/Universal-Turing-machine/Racket/universal-turing-machine-5.rkt Normal file
View file

@ -0,0 +1,16 @@
(define SORT
(Turing-Machine #:start 'A
[A 1 1 right A]
[A 2 3 right B]
[A () () left E]
[B 1 1 right B]
[B 2 2 right B]
[B () () 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 () () right STOP]))

83
Task/Universal-Turing-machine/Raku/universal-turing-machine.raku Normal file
View file

@ -0,0 +1,83 @@
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 >]
];

62
Task/Universal-Turing-machine/Ruby/universal-turing-machine-1.rb Normal file
View file

@ -0,0 +1,62 @@
class Turing
class Tape
def initialize(symbols, blank, starting_tape)
@symbols = symbols
@blank = blank
@tape = starting_tape
@index = 0
end
def read
retval = @tape[@index]
unless retval
retval = @tape[@index] = @blank
end
raise "invalid symbol '#{retval}' on tape" unless @tape.member?(retval)
return retval
end
def write(symbol)
@tape[@index] = symbol
end
def right
@index += 1
end
def left
if @index == 0
@tape.unshift @blank
else
@index -= 1
end
end
def stay
# nop
end
def get_tape
return @tape
end
end
def initialize(symbols, blank,
initial_state, halt_states, running_states,
rules, starting_tape = [])
@tape = Tape.new(symbols, blank, starting_tape)
@initial_state = initial_state
@halt_states = halt_states
@running_states = running_states
@rules = rules
@halted = false
end
def run
raise "machine already halted" if @halted
state = @initial_state
while (true)
break if @halt_states.member? state
raise "unknown state '#{state}'" unless @running_states.member? state
symbol = @tape.read
outsym, action, state = @rules[state][symbol]
@tape.write outsym
@tape.send action
end
@halted = true
return @tape.get_tape
end
end

12
Task/Universal-Turing-machine/Ruby/universal-turing-machine-2.rb Normal file
View file

@ -0,0 +1,12 @@
incrementer_rules = {
:q0 => { 1 => [1, :right, :q0],
:b => [1, :stay, :qf]}
}
t = Turing.new([:b, 1], # permitted symbols
:b, # blank symbol
:q0, # starting state
[:qf], # terminating states
[:q0], # running states
incrementer_rules, # operating rules
[1, 1, 1]) # starting tape
print t.run, "\n"

16
Task/Universal-Turing-machine/Ruby/universal-turing-machine-3.rb Normal file
View file

@ -0,0 +1,16 @@
busy_beaver_rules = {
:a => { 0 => [1, :right, :b],
1 => [1, :left, :c]},
:b => { 0 => [1, :left, :a],
1 => [1, :right, :b]},
:c => { 0 => [1, :left, :b],
1 => [1, :stay, :halt]}
}
t = Turing.new([0, 1], # permitted symbols
0, # blank symbol
:a, # starting state
[:halt], # terminating states
[:a, :b, :c], # running states
busy_beaver_rules, # operating rules
[]) # starting tape
print t.run, "\n"

142
Task/Universal-Turing-machine/Rust/universal-turing-machine.rust Normal file
View file

@ -0,0 +1,142 @@
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 }
}
}

225
Task/Universal-Turing-machine/Scala/universal-turing-machine.scala Normal file
View file

@ -0,0 +1,225 @@
package utm.scala
import scala.annotation.tailrec
import scala.language.implicitConversions
/**
* Implementation of Universal Turing Machine in Scala that can simulate an arbitrary
* Turing machine on arbitrary input
*
* @author Abdulla Abdurakhmanov (https://github.com/abdolence/utms)
*/
class UniversalTuringMachine[S](
val rules: List[UTMRule[S]],
val initialState: S,
val finalStates: Set[S],
val blankSymbol: String,
val inputTapeVals: Iterable[String],
printEveryIter: Int = 1
) {
private val initialTape = UTMTape( inputTapeVals.toVector, 0, blankSymbol )
@tailrec
private def iterate( state: S, curIteration: Int, tape: UTMTape ): UTMTape = {
if (curIteration % printEveryIter == 0) {
print( s"${curIteration}: ${state}: " )
tape.printTape()
}
if (finalStates.contains( state )) {
println( s"Finished in the final state: ${state}" )
tape.printTape()
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
}
}
}
}
def run(): UTMTape =
iterate( state = initialState, curIteration = 0, tape = initialTape )
}
/**
* Universal Turing Machine actions
*/
sealed trait UTMAction
object UTMAction {
case object left extends UTMAction
case object right extends UTMAction
case object stay extends UTMAction
}
/**
* Universal Turing Machine rule definition
*/
case class UTMRule[S]( state: S, fromSymbol: String, toSymbol: String, action: UTMAction, toState: S )
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
}
private[scala] def updated( symbol: String, action: UTMAction ): UTMTape = {
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
)
} else if (updatedTape.position >= updatedTape.content.length) {
updatedTape.copy( content = updatedTape.content :+ blankSymbol )
} else
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( "]" )
}
}
object UniversalTuringMachine extends App {
main()
def main(): Unit = {
import UTMAction._
def createIncrementMachine() = {
sealed trait IncrementStates
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 FA extends FiveBeaverStates
case object FB extends FiveBeaverStates
case object FC extends FiveBeaverStates
case object FD extends FiveBeaverStates
case object FE extends FiveBeaverStates
case object FH extends FiveBeaverStates
new UniversalTuringMachine[FiveBeaverStates](
rules = List(
( FA, "0", "1", right, FB ),
( FA, "1", "1", left, FC ),
( FB, "0", "1", right, FC ),
( FB, "1", "1", right, FB ),
( FC, "0", "1", right, FD ),
( FC, "1", "0", left, FE ),
( 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()
}
}

330
Task/Universal-Turing-machine/Scheme/universal-turing-machine-1.ss Normal file
View file

@ -0,0 +1,330 @@
;----------------------------------------------------------------------------------------------
; 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)))))))
;----------------------------------------------------------------------------------------------

37
Task/Universal-Turing-machine/Scheme/universal-turing-machine-2.ss Normal file
View file

@ -0,0 +1,37 @@
;----------------------------------------------------------------------------------------------
; 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)))))))
;----------------------------------------------------------------------------------------------

57
Task/Universal-Turing-machine/Scheme/universal-turing-machine-3.ss Normal file
View file

@ -0,0 +1,57 @@
(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)

109
Task/Universal-Turing-machine/Scheme/universal-turing-machine-4.ss Normal file
View file

@ -0,0 +1,109 @@
(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)

218
Task/Universal-Turing-machine/SequenceL/universal-turing-machine-1.sequencel Normal file
View file

@ -0,0 +1,218 @@
//region Imports
import <Utilities/Conversion.sl>;
import <Utilities/Sequence.sl>;
//endregion
//region Types
MCONFIG ::= (Label: char(1), Symbols: char(2), Operations: char(2), FinalConfig: char(1));
STATE ::= (CurrentConfig: char(1), CurrentPosition: int(0), Tape: char(1));
INPUT_DATA ::= (Iterations: int(0), InitialTape: char(1), StartingPosition: int(0), InitialConfig: char(1), MConfigs: MCONFIG(1));
//endregion
//region Constants
SPACE_CHAR := '_';
DELIMITTER := '|';
NULL_CONFIG := (Label: "", Symbols: [], Operations: [], FinalConfig: "");
TRACE_HEADER := ["Config:\t| Place:\t| Tape:"];
//endregion
//region Helpers
StateToString(state(0)) :=
state.CurrentConfig ++
" \t\t| " ++ intToString(state.CurrentPosition) ++
" \t| " ++ state.Tape;
StateToArrowString(state(0)) :=
state.Tape ++ "\n" ++
duplicate(' ', state.CurrentPosition - 1) ++ "|\n" ++
duplicate(' ', state.CurrentPosition - 1) ++ state.CurrentConfig ++ "\n";
HeadOfEach(strings(2))[i] :=
head(strings[i]);
RemoveCharacter(character(0), string(1))[i] :=
string[i] when not(string[i] = character);
GetFSquares(Tape(1))[i] :=
Tape[i] when (i mod 2) = 1;
//endregion
//region Parsing
ParseConfig(Line(1)) :=
let
entries := split(Line, DELIMITTER);
label := entries[1];
symbols := split(entries[2], ',');
operations := split(entries[3], ',');
finalConfig := entries[4];
in
((Label: label, Symbols: symbols, Operations: operations, FinalConfig: finalConfig) when not((Line[1] = '/') and (Line[2] = '/')))
when size(Line) > 0;
ParseTextFile(Text(1)) :=
let
noSpaces := RemoveCharacter('\t', RemoveCharacter('\r', RemoveCharacter(' ', Text)));
lines := split(noSpaces, '\n');
iterations := stringToInt(lines[1]);
initialTape := lines[2];
initialPosition := stringToInt(lines[3]);
initialConfig := lines[4];
mConfigs := ParseConfig(lines[5 ... size(lines)]);
in
(Iterations: iterations, InitialTape: initialTape, StartingPosition: initialPosition, InitialConfig: initialConfig, MConfigs: mConfigs);
//endregion
//region Config Finding
Matches: char(0) * char(2) -> bool;
Matches(currentSymbol(0), symbols(2)) :=
true when size(symbols) = 0 //some(equalListNT("", symbols))
else
true when currentSymbol = SPACE_CHAR and some(equalListNT("none", symbols))
else
true when not(currentSymbol = SPACE_CHAR) and some(equalListNT("any", symbols))
else
true when some(currentSymbol = HeadOfEach(symbols))
else
false;
GetCurrentSymbol(State(0)) :=
State.Tape[State.CurrentPosition] when size(State.Tape) >= State.CurrentPosition and State.CurrentPosition > 0
else
SPACE_CHAR;
GetConfigHelper(label(1), symbol(0), mConfigs(1))[i] :=
mConfigs[i] when equalList(mConfigs[i].Label, label) and Matches(symbol, mConfigs[i].Symbols);
GetConfig(label(1), symbol(0), mConfigs(1)) :=
let
searchResults := GetConfigHelper(label, symbol, mConfigs);
in
NULL_CONFIG when size(searchResults) = 0
else
searchResults[1];
//endregion
//region Operations
TrimTapeEnd(tape(1), position(0)) :=
tape when position = size(tape)
else
tape when not(last(tape) = SPACE_CHAR)
else
TrimTapeEnd(allButLast(tape), position);
ApplyOperations(State(0), Operations(2)) :=
let
newState := ApplyOperation(State, head(Operations));
in
State when size(Operations) = 0
else
ApplyOperations(newState, tail(Operations));
ApplyOperation(State(0), Operation(1)) :=
let
newTape :=
PrintOperation(head(tail(Operation)), State.CurrentPosition, State.Tape) when head(Operation) = 'P'
else
EraseOperation(State.CurrentPosition, State.Tape) when head(Operation) = 'E'
else
[SPACE_CHAR] ++ State.Tape when head(Operation) = 'L' and State.CurrentPosition = 1
else
State.Tape ++ [SPACE_CHAR] when head(Operation) = 'R' and State.CurrentPosition = size(State.Tape)
else
State.Tape;
newPosition :=
1 when head(Operation) = 'L' and State.CurrentPosition = 1
else
State.CurrentPosition + 1 when head(Operation) = 'R'
else
State.CurrentPosition - 1 when head(Operation) = 'L'
else
State.CurrentPosition;
trimmedTape := TrimTapeEnd(newTape, newPosition);
in
State when size(Operation) = 0
else
(CurrentPosition: newPosition, Tape: trimmedTape);
PrintOperation(Symbol(0), Position(0), Tape(1)) :=
let
diff := Position - size(Tape) when Position > size(Tape) else 0;
expandedTape := Tape ++ duplicate(SPACE_CHAR, diff);
finalTape := setElementAt(expandedTape, Position, Symbol);
in
finalTape;
EraseOperation(Position(0), Tape(1)) :=
PrintOperation(SPACE_CHAR, Position, Tape);
//endregion
//region Execution
RunMachine(Text(1), Flag(1)) :=
let
input := ParseTextFile(Text);
initialState := (CurrentConfig: input.InitialConfig, CurrentPosition: input.StartingPosition, Tape: input.InitialTape);
processed := Process(initialState, input.MConfigs, input.Iterations);
processedWithTrace := ProcessWithTrace(initialState, input.MConfigs, input.Iterations);
in
"\n" ++ delimit(TRACE_HEADER ++ StateToString(processedWithTrace), '\n') when equalList(Flag, "trace")
else
"\n" ++ delimit(StateToArrowString(processedWithTrace), '\n') when equalList(Flag, "arrow-trace")
else
processed.Tape when equalList(Flag, "tape")
else
TrimTapeEnd(GetFSquares(processed.Tape), 1) when equalList(Flag, "f-squares")
else
boolToString(DoesMachineHalt(initialState, input.MConfigs, input.Iterations)) when equalList(Flag, "halts")
else
StateToString(processed);
DoesMachineHalt(InitialState(0), mConfigs(1), Iterations(0)) :=
let
resultState := Process(InitialState, mConfigs, Iterations);
in
equalList(resultState.CurrentConfig, "halt");
ProcessWithTrace(InitialState(0), mConfigs(1), Iterations(0)) :=
[InitialState] when Iterations <= 0 or size(InitialState.CurrentConfig) = 0 or equalList(InitialState.CurrentConfig, "halt")
else
[InitialState] ++ ProcessWithTrace(Iterate(InitialState, mConfigs), mConfigs, Iterations - 1);
Process(InitialState(0), mConfigs(1), Iterations(0)) :=
InitialState when Iterations = 0 or size(InitialState.CurrentConfig) = 0 or equalList(InitialState.CurrentConfig, "halt")
else
Process(Iterate(InitialState, mConfigs), mConfigs, Iterations - 1);
Iterate(State(0), mConfigs(1)) :=
let
currentConfig := GetConfig(State.CurrentConfig, GetCurrentSymbol(State), mConfigs);
newState := Execute(State, currentConfig);
in
newState;
Execute(State(0), mConfig(0)) :=
let
newState := ApplyOperations(State, mConfig.Operations);
in
(CurrentConfig: mConfig.FinalConfig, CurrentPosition: newState.CurrentPosition, Tape: newState.Tape);
//endregion

67
Task/Universal-Turing-machine/SequenceL/universal-turing-machine-2.sequencel Normal file
View file

@ -0,0 +1,67 @@
#include <iostream>
#include <fstream>
#include <string>
#include <cerrno>
#include "SL_Generated.h"
int cores = 0;
string fileName = "../../INPUT/irrational.tm";
string flag = "tape";
string fileContents = "";
using namespace std;
std::string get_file_contents(const char *filename);
int main( int argc, char** argv )
{
if(argc >= 2)
{
fileName = argv[1];
}
if(argc >= 3)
{
flag = argv[2];
}
if(argc >= 4)
{
cores = atoi(argv[3]);
}
int flagDims[] = { flag.length(), 0};
Sequence<char> flagSeq((void*)(flag.c_str()), flagDims);
fileContents = get_file_contents(fileName.c_str());
int inputDims[] = { fileContents.length(), 0};
Sequence<char> input((void*)(fileContents.c_str()), inputDims);
Sequence<char> result;
sl_init(cores);
sl_RunMachine(input, flagSeq, cores, result);
cout<<result<<endl;
sl_done();
return 0;
}
std::string get_file_contents(const char *filename)
{
std::ifstream in(filename, std::ios::in | std::ios::binary);
if (in)
{
std::string contents;
in.seekg(0, std::ios::end);
contents.resize(in.tellg());
in.seekg(0, std::ios::beg);
in.read(&contents[0], contents.size());
in.close();
return(contents);
}
throw(errno);
}

98
Task/Universal-Turing-machine/Sidef/universal-turing-machine.sidef Normal file
View file

@ -0,0 +1,98 @@
func run_utm(state="", blank="", rules=[], tape=[blank], halt="", pos=0) {
if (pos < 0) {
pos += tape.len;
}
if (pos !~ tape.range) {
die "Bad initial position";
}
loop {
print "#{state}\t";
tape.range.each { |i|
var v = tape[i];
print (i == pos ? "[#{v}]" : " #{v} ");
};
print "\n";
if (state == halt) {
break;
}
rules.each { |rule|
var (s0, v0, v1, dir, s1) = rule...;
if ((s0 != state) || (tape[pos] != v0)) {
next;
}
tape[pos] = v1;
given(dir) {
when ('left') {
if (pos == 0) { tape.unshift(blank) }
else { --pos };
}
when ('right') {
if (++pos >= tape.len) {
tape.append(blank)
}
}
}
state = s1;
goto :NEXT;
}
die 'No matching rules';
@:NEXT;
}
}
print "incr machine\n";
run_utm(
halt: 'qf',
state: 'q0',
tape: %w(1 1 1),
blank: 'B',
rules: [
%w(q0 1 1 right q0),
%w(q0 B 1 stay qf),
]);
say "\nbusy beaver";
run_utm(
halt: 'halt',
state: 'a',
blank: '0',
rules: [
%w(a 0 1 right b),
%w(a 1 1 left c),
%w(b 0 1 left a),
%w(b 1 1 right b),
%w(c 0 1 left b),
%w(c 1 1 stay halt),
]);
say "\nsorting test";
run_utm(
halt: 'STOP',
state: 'A',
blank: '0',
tape: %w(2 2 2 1 2 2 1 2 1 2 1 2 1 2),
rules: [
%w(A 1 1 right A),
%w(A 2 3 right B),
%w(A 0 0 left E),
%w(B 1 1 right B),
%w(B 2 2 right B),
%w(B 0 0 left C),
%w(C 1 2 left D),
%w(C 2 2 left C),
%w(C 3 2 left E),
%w(D 1 1 left D),
%w(D 2 2 left D),
%w(D 3 1 right A),
%w(E 1 1 left E),
%w(E 0 0 right STOP),
]);

18
Task/Universal-Turing-machine/Sinclair-ZX81-BASIC/universal-turing-machine-1.basic Normal file
View file

@ -0,0 +1,18 @@
1000 PRINT AT 0,0;T$
1010 LET P=1
1020 IF P>LEN T$ THEN LET T$=T$+B$
1030 PRINT AT INT (P/32),P-(32*INT (P/32)+1);CHR$ (CODE T$(P)+128)
1040 LET R=1
1050 IF R$(R,1)=S$ AND R$(R,2)=T$(P) THEN GOTO 1080
1060 LET R=R+1
1070 GOTO 1050
1080 LET T$(P)=R$(R,3)
1090 PRINT AT INT (P/32),P-(32*INT (P/32)+1);T$(P)
1100 IF R$(R,4)="L" THEN LET P=P-1
1110 IF R$(R,4)="R" THEN LET P=P+1
1120 LET S$=R$(R,5)
1130 IF S$=H$ THEN STOP
1140 IF P=0 THEN GOTO 1160
1150 GOTO 1020
1160 LET T$=B$+T$
1170 GOTO 1000

7
Task/Universal-Turing-machine/Sinclair-ZX81-BASIC/universal-turing-machine-2.basic Normal file
View file

@ -0,0 +1,7 @@
10 DIM R$(2,5)
20 LET S$=CHR$ (CODE "Q"+CODE "0")
30 LET H$=CHR$ (CODE "Q"+CODE "F")
40 LET R$(1)=S$+"11R"+S$
50 LET R$(2)=S$+"B1S"+H$
60 LET B$="B"
70 LET T$="111"

11
Task/Universal-Turing-machine/Sinclair-ZX81-BASIC/universal-turing-machine-3.basic Normal file
View file

@ -0,0 +1,11 @@
10 DIM R$(6,5)
20 LET R$(1)="A01RB"
30 LET R$(2)="A11LC"
40 LET R$(3)="B01LA"
50 LET R$(4)="B11RB"
60 LET R$(5)="C01LB"
70 LET R$(6)="C11SH"
80 LET T$=""
90 LET S$="A"
100 LET B$="0"
110 LET H$="H"

331
Task/Universal-Turing-machine/Standard-ML/universal-turing-machine.ml Normal file
View file

@ -0,0 +1,331 @@
(*** Signatures ***)
signature TAPE = sig
datatype move = Left | Right | Stay
type ''a tape
val empty : ''a tape
val moveLeft : ''a tape -> ''a tape
val moveRight : ''a tape -> ''a tape
val move : ''a tape -> move -> ''a tape
val getSymbol : ''a tape -> ''a option
val write : ''a option -> ''a tape -> ''a tape
val leftOf : ''a tape -> ''a option list (* Symbols left of the head in reverse order *)
val rightOf : ''a tape -> ''a option list (* Symbols right of of the head *)
end
signature MACHINE = sig
structure Tape : TAPE
type state = int
(* ''a is band alphabet type *)
type ''a transitions = (state * ''a option Vector.vector) ->
(state * (Tape.move * ''a option) Vector.vector)
type ''a configuration = { state : state, tapes : ''a Tape.tape Vector.vector }
type ''a machine = {
alphabet : ''a Vector.vector, (* (not used) *)
states : state Vector.vector, (* (not used) *)
start : state, (* element of stats *)
final : state, (* element of stats *)
transitions : ''a transitions, (* transitions *)
tapes : ''a Tape.tape Vector.vector (* vector of the initial tapes *)
}
end
signature UNIVERSALMACHINE = sig
structure Machine : MACHINE
val start : ''a Machine.machine -> ''a Machine.configuration
(* Find a holding configuration (limited by n steps)
* Execute the handler for each step *)
val simulate : (''a Machine.configuration -> unit) -> ''a Machine.machine -> int option -> ''a Machine.configuration option
end
(*** Implementation ***)
structure Tape :> TAPE = struct
(*
* NONE => blank field
* SOME a => written field
*)
type ''a symbol = ''a option
datatype move = Left | Right | Stay
(*
* Four cases:
* 1 The tape is complete empty.
* 2 The head is in the written area.
* On the right and on the left handside are symbols,
* On the head is a symbol.
* 3/4 The head is (n-1) fields over the right/left edge of the written area.
* There is at least one entry and a rest list of entries.
*)
datatype ''a tape =
Empty
| Middle of ''a symbol list * ''a symbol * ''a symbol list
| LeftOf of ''a symbol * ''a symbol list * int
| RightOf of ''a symbol * ''a symbol list * int
val empty = Empty
fun rep a 0 = nil
| rep a n = a :: rep a (n-1)
fun leftOf (Empty) = nil
| leftOf (Middle (ls, _, _)) = ls
| leftOf (RightOf (r, rs, i)) = rep NONE i @ r :: rs
| leftOf (LeftOf _) = nil
fun rightOf (Empty) = nil
| rightOf (Middle (_, _, rs)) = rs
| rightOf (RightOf _) = nil
| rightOf (LeftOf (l, ls, i)) = rep NONE i @ l :: ls
fun write (NONE) t = t (* Cannot write a blank field! *)
| write a t = Middle (leftOf t, a, rightOf t)
fun getSymbol (Middle (_, m, _)) = m
| getSymbol _ = NONE (* blank *)
fun moveRight (Empty) = Empty
| moveRight (Middle (ls, m, nil)) = RightOf (m, ls, 0)
| moveRight (Middle (ls, m, r::rs)) = Middle (m::ls, r, rs)
| moveRight (RightOf (l, ls, n)) = RightOf (l, ls, n+1)
| moveRight (LeftOf (r, rs, 0)) = Middle (nil, r, rs)
| moveRight (LeftOf (r, rs, n)) = LeftOf (r, rs, n-1)
fun moveLeft (Empty) = Empty
| moveLeft (Middle (nil, m, rs)) = LeftOf (m, rs, 0)
| moveLeft (Middle (l::ls, m, rs)) = Middle (ls, l, m::rs)
| moveLeft (RightOf (l, ls, 0)) = Middle (ls, l, nil)
| moveLeft (RightOf (l, ls, n)) = RightOf (l, ls, n-1)
| moveLeft (LeftOf (r, rs, n)) = LeftOf (r, rs, n+1)
fun move tape Stay = tape
| move tape Right = moveRight tape
| move tape Left = moveLeft tape
(* Test *)
local
val tape : int tape = empty (* [] *)
val tape = moveRight tape (* [] *)
val NONE = getSymbol tape
val tape = write (SOME 42) tape (* [42] *)
val (SOME 42) = getSymbol tape
val tape = moveRight tape (* 42, [] *)
val tape = moveRight tape (* 42, , [] *)
val NONE = getSymbol tape
val tape = moveLeft tape (* 42, [] *)
val NONE = getSymbol tape
val tape = moveLeft tape (* [42] *)
val (SOME 42) = getSymbol tape
val tape = write NONE tape (* [42] *) (* !!! *)
val (SOME 42) = getSymbol tape
val tape = moveLeft tape (* [], 42 *)
val tape = moveLeft tape (* [], , 42 *)
val tape = write (SOME 47) tape (* [47], , 42 *)
val (SOME 47) = getSymbol tape
val tape = moveRight tape (* 47, [], 42 *)
val NONE = getSymbol tape
val tape = moveRight tape (* 47, , [42] *)
val (SOME 42) = getSymbol tape
in end
end
structure Machine :> MACHINE = struct
structure Tape = Tape
type state = int
(* ''a is band alphabet type *)
type ''a transitions = (state * ''a option Vector.vector) ->
(state * (Tape.move * ''a option) Vector.vector)
type ''a configuration = { state : state, tapes : ''a Tape.tape Vector.vector }
type ''a machine = {
alphabet : ''a Vector.vector,
states : state Vector.vector,
start : state,
final : state,
transitions : ''a transitions,
tapes : ''a Tape.tape Vector.vector
}
end
structure UniversalMachine :> UNIVERSALMACHINE = struct
structure Machine = Machine
fun start ({ start, tapes, ... } : ''a Machine.machine) : ''a Machine.configuration = {
state = start,
tapes = tapes
}
fun doTransition ({ state, tapes } : ''a Machine.configuration)
((state', actions) : (Machine.state * (Machine.Tape.move * ''a option) Vector.vector))
: ''a Machine.configuration = {
state = state',
tapes = Vector.mapi (fn (i, tape) =>
let val (move, write) = Vector.sub (actions, i)
val tape' = Machine.Tape.write write tape
val tape'' = Machine.Tape.move tape' move
in tape'' end) tapes
}
fun getSymbols ({ tapes, ... } : ''a Machine.configuration) : ''a option Vector.vector =
Vector.map (Machine.Tape.getSymbol) tapes
fun step ({ transitions, ... } : ''a Machine.machine) (conf : ''a Machine.configuration) : ''a Machine.configuration =
doTransition conf (transitions (#state conf, getSymbols conf))
fun isFinal ({final, ...} : ''a Machine.machine) ({state, ...} : ''a Machine.configuration) : bool =
final = state
fun iter term (SOME 0) f s = NONE
| iter term (SOME n) f s = if term s then SOME s else iter term (SOME (n-1)) f (f s)
| iter term NONE f s = if term s then SOME s else iter term NONE f (f s)
fun simulate handler (machine : ''a Machine.machine) optcount =
let val endconf = iter (isFinal machine) optcount (fn conf => (handler conf; step machine conf)) (start machine)
in case endconf of NONE => NONE | SOME conf => (handler conf; endconf) end
end
structure ExampleMachines = struct
structure Machine = UniversalMachine.Machine
(* Tranform the 5-Tuple notation into the vector function *)
fun makeTransitions nil : ''a Machine.transitions = (fn (t, vec) => (print (Int.toString t); raise Subscript))
| makeTransitions ((s : Machine.state,
read : ''a option,
write : ''a option,
move : Machine.Tape.move,
s' : Machine.state) :: ts) =
fn (t, vec) =>
if s=t andalso vec=(Vector.fromList [read])
then (s', Vector.fromList [(move, write)])
else makeTransitions ts (t, vec)
(* `createTape xs` creates an tape initialized by xs, where the head stands on the first element of xs *)
fun createTape' nil = Machine.Tape.empty
| createTape' (x::xs) = Machine.Tape.moveLeft (Machine.Tape.write x (createTape' xs))
fun createTape xs = Machine.Tape.moveRight (createTape' (rev xs))
(* Convert a tape into a string to print it. It needs a function that converts each symbol to string *)
fun tapeToStr (symStr : ''a -> string) (tape : ''a Machine.Tape.tape) : string =
let val left : ''a option list = rev (Machine.Tape.leftOf tape)
val right : ''a option list = Machine.Tape.rightOf tape
val current : ''a option = Machine.Tape.getSymbol tape
val symToStr : ''a option -> string = (fn (NONE) => "#" | (SOME a) => symStr a)
in
String.concatWith " " ((map symToStr left) @ [ "|" ^ symToStr current ^ "|" ] @ (map symToStr right))
end
(* Convert a vector to a list *)
fun vectToList vect = List.tabulate (Vector.length vect, fn i => Vector.sub (vect, i))
(* Do this before every step and after the last step. *)
fun handler (symToStr : ''a -> string) ({state, tapes} : ''a Machine.configuration) : unit =
let
val str = "State " ^ Int.toString state ^ "\n" ^
String.concat (vectToList (Vector.mapi (fn (i, tape) => "Tape #" ^ Int.toString i ^ ": " ^
tapeToStr symToStr tape ^ "\n") tapes))
in
print str
end
(* Simulate and make result into string *)
fun simulate (symToStr : ''a -> string) (machine : ''a Machine.machine)
(optcount : int option) : string =
case (UniversalMachine.simulate (handler symToStr) machine optcount) of
NONE => "Did not terminate."
| SOME ({state, tapes} : ''a Machine.configuration) => "Terminated."
(* Now finaly the machines! *)
val incrementer : unit Machine.machine = {
alphabet = Vector.fromList [()],
states = Vector.fromList [0, 1],
start = 0,
final = 1,
tapes = Vector.fromList [createTape (map SOME [(), (), (), ()])],
transitions = makeTransitions [
(0, SOME (), SOME (), Machine.Tape.Right, 0),
(0, NONE, SOME (), Machine.Tape.Stay, 1)]
}
val busybeaver : unit Machine.machine = {
alphabet = Vector.fromList [()],
states = Vector.fromList [0, 1, 2, 3],
start = 0,
final = 3,
tapes = Vector.fromList [Machine.Tape.empty],
transitions = makeTransitions [
(0, NONE, SOME (), Machine.Tape.Right, 1),
(0, SOME (), SOME (), Machine.Tape.Left, 2),
(1, NONE, SOME (), Machine.Tape.Left, 0),
(1, SOME (), SOME (), Machine.Tape.Right, 1),
(2, NONE, SOME (), Machine.Tape.Left, 1),
(2, SOME (), SOME (), Machine.Tape.Stay, 3)]
}
val sorting : int Machine.machine = {
alphabet = Vector.fromList [1,2,3],
states = Vector.fromList [0,1,2,3,4,5],
start = 1,
final = 0,
tapes = Vector.fromList [createTape (map SOME [2, 1, 2, 2, 1, 1])],
transitions = makeTransitions [
(1, SOME 1, SOME 1, Machine.Tape.Right, 1),
(1, SOME 2, SOME 3, Machine.Tape.Right, 2),
(1, NONE, NONE, Machine.Tape.Left, 5),
(2, SOME 1, SOME 1, Machine.Tape.Right, 2),
(2, SOME 2, SOME 2, Machine.Tape.Right, 2),
(2, NONE, NONE, Machine.Tape.Left, 3),
(3, SOME 1, SOME 2, Machine.Tape.Left, 3),
(3, SOME 2, SOME 2, Machine.Tape.Left, 3),
(3, SOME 3, SOME 2, Machine.Tape.Left, 5),
(4, SOME 1, SOME 1, Machine.Tape.Left, 4),
(4, SOME 2, SOME 2, Machine.Tape.Left, 4),
(4, SOME 3, SOME 1, Machine.Tape.Right, 1),
(5, SOME 1, SOME 1, Machine.Tape.Left, 5),
(5, NONE, NONE, Machine.Tape.Right, 0)]
}
end
(** Invoke Simulations **)
local
open ExampleMachines
val unitToString = (fn () => "()")
fun simulate_unit machine optcount = print (simulate unitToString machine optcount ^ "\n")
fun simulate_int machine optcount = print (simulate Int.toString machine optcount ^ "\n")
in
val () = print "Simulate incrementer...\n\n"
val () = simulate_unit incrementer NONE
val () = print "\nSimulate Busy Beaver...\n\n"
val () = simulate_unit busybeaver NONE
val () = print "\nSimulate Sorting...\n\n"
val () = simulate_int sorting NONE
end

37
Task/Universal-Turing-machine/Tcl/universal-turing-machine-1.tcl Normal file
View file

@ -0,0 +1,37 @@
proc turing {states initial terminating symbols blank tape rules {doTrace 1}} {
set state $initial
set idx 0
set tape [split $tape ""]
if {[llength $tape] == 0} {
set tape [list $blank]
}
foreach rule $rules {
lassign $rule state0 sym0 sym1 move state1
set R($state0,$sym0) [list $sym1 $move $state1]
}
while {$state ni $terminating} {
set sym [lindex $tape $idx]
lassign $R($state,$sym) sym1 move state1
if {$doTrace} {
### Print the state, great for debugging
puts "[join $tape ""]\t$state->$state1"
puts "[string repeat { } $idx]^"
}
lset tape $idx $sym1
switch $move {
left {
if {[incr idx -1] < 0} {
set idx 0
set tape [concat [list $blank] $tape]
}
}
right {
if {[incr idx] == [llength $tape]} {
lappend tape $blank
}
}
}
set state $state1
}
return [join $tape ""]
}

32
Task/Universal-Turing-machine/Tcl/universal-turing-machine-2.tcl Normal file
View file

@ -0,0 +1,32 @@
puts "Simple incrementer"
puts TAPE=[turing {q0 qf} q0 qf {1 B} B "111" {
{q0 1 1 right q0}
{q0 B 1 stay qf}
}]
puts "Three-state busy beaver"
puts TAPE=[turing {a b c halt} a halt {0 1} 0 "" {
{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}
}]
puts "Sorting stress test"
# We suppress the trace output for this so as to keep the output short
puts TAPE=[turing {A B C D E H} A H {0 1 2 3} 0 "12212212121212" {
{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}
} no]

65
Task/Universal-Turing-machine/UNIX-Shell/universal-turing-machine.sh Normal file
View file

@ -0,0 +1,65 @@
#!/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 "$@"

113
Task/Universal-Turing-machine/VBA/universal-turing-machine.vba Normal file
View file

@ -0,0 +1,113 @@
Option Base 1
Public Enum sett
name_ = 1
initState
endState
blank
rules
End Enum
Public incrementer As Variant, threeStateBB As Variant, fiveStateBB As Variant
'-- Machine definitions
Private Sub init()
incrementer = Array("Simple incrementer", _
"q0", _
"qf", _
"B", _
Array( _
Array("q0", "1", "1", "right", "q0"), _
Array("q0", "B", "1", "stay", "qf")))
threeStateBB = Array("Three-state busy beaver", _
"a", _
"halt", _
"0", _
Array( _
Array("a", "0", "1", "right", "b"), _
Array("a", "1", "1", "left", "c"), _
Array("b", "0", "1", "left", "a"), _
Array("b", "1", "1", "right", "b"), _
Array("c", "0", "1", "left", "b"), _
Array("c", "1", "1", "stay", "halt")))
fiveStateBB = Array("Five-state busy beaver", _
"A", _
"H", _
"0", _
Array( _
Array("A", "0", "1", "right", "B"), _
Array("A", "1", "1", "left", "C"), _
Array("B", "0", "1", "right", "C"), _
Array("B", "1", "1", "right", "B"), _
Array("C", "0", "1", "right", "D"), _
Array("C", "1", "0", "left", "E"), _
Array("D", "0", "1", "left", "A"), _
Array("D", "1", "1", "left", "D"), _
Array("E", "0", "1", "stay", "H"), _
Array("E", "1", "0", "left", "A")))
End Sub
Private Sub show(state As String, headpos As Long, tape As Collection)
Debug.Print " "; state; String$(7 - Len(state), " "); "| ";
For p = 1 To tape.Count
Debug.Print IIf(p = headpos, "[" & tape(p) & "]", " " & tape(p) & " ");
Next p
Debug.Print
End Sub
'-- a universal turing machine
Private Sub UTM(machine As Variant, tape As Collection, Optional countOnly As Long = 0)
Dim state As String: state = machine(initState)
Dim headpos As Long: headpos = 1
Dim counter As Long, rule As Variant
Debug.Print machine(name_); vbCrLf; String$(Len(machine(name_)), "=")
If Not countOnly Then Debug.Print " State | Tape [head]" & vbCrLf & "---------------------"
Do While True
If headpos > tape.Count Then
tape.Add machine(blank)
Else
If headpos < 1 Then
tape.Add machine(blank), Before:=1
headpos = 1
End If
End If
If Not countOnly Then show state, headpos, tape
For i = LBound(machine(rules)) To UBound(machine(rules))
rule = machine(rules)(i)
If rule(1) = state And rule(2) = tape(headpos) Then
tape.Remove headpos
If headpos > tape.Count Then
tape.Add rule(3)
Else
tape.Add rule(3), Before:=headpos
End If
If rule(4) = "left" Then headpos = headpos - 1
If rule(4) = "right" Then headpos = headpos + 1
state = rule(5)
Exit For
End If
Next i
counter = counter + 1
If counter Mod 100000 = 0 Then
Debug.Print counter
DoEvents
DoEvents
End If
If state = machine(endState) Then Exit Do
Loop
DoEvents
If countOnly Then
Debug.Print "Steps taken: ", counter
Else
show state, headpos, tape
Debug.Print
End If
End Sub
Public Sub main()
init
Dim tap As New Collection
tap.Add "1": tap.Add "1": tap.Add "1"
UTM incrementer, tap
Set tap = New Collection
UTM threeStateBB, tap
Set tap = New Collection
UTM fiveStateBB, tap, countOnly:=-1
End Sub

154
Task/Universal-Turing-machine/Wren/universal-turing-machine.wren Normal file
View file

@ -0,0 +1,154 @@
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)

113
Task/Universal-Turing-machine/Yabasic/universal-turing-machine.basic Normal file
View file

@ -0,0 +1,113 @@
// Machine definitions
name = 1 : initState = 2 : endState = 3 : blank = 4 : countOnly = true
incrementer$ = "Simple incrementer,q0,qf,B"
incrementer$ = incrementer$ + ",q0,1,1,right,q0,q0,B,1,stay,qf"
threeStateBB$ = "Three-state busy beaver,a,halt,0"
data "a,0,1,right,b"
data "a,1,1,left,c"
data "b,0,1,left,a"
data "b,1,1,right,b"
data "c,0,1,left,b"
data "c,1,1,stay,halt"
data ""
do
read a$
if a$ = "" break
threeStateBB$ = threeStateBB$ + "," + a$
loop
fiveStateBB$ = "Five-state busy beaver,A,H,0"
data "A,0,1,right,B"
data "A,1,1,left,C"
data "B,0,1,right,C"
data "B,1,1,right,B"
data "C,0,1,right,D"
data "C,1,0,left,E"
data "D,0,1,left,A"
data "D,1,1,left,D"
data "E,0,1,stay,H"
data "E,1,0,left,A"
data ""
do
read a$
if a$ = "" break
fiveStateBB$ = fiveStateBB$ + "," + a$
loop
clear screen
// Display a representation of the tape and machine state on the screen
sub show(state$, headPos, tape$)
local pos
print " ", state$, "\t| ";
for pos = 1 to len(tape$)
if pos = headPos then print "[", mid$(tape$, pos, 1), "] "; else print " ", mid$(tape$, pos, 1), " "; end if
next
print
end sub
sub string.rep$(s$, n)
local i, r$
for i = 1 to n
r$ = r$ + s$
next
return r$
end sub
// Simulate a turing machine
sub UTM(mach$, tape$, countOnly)
local state$, headPos, counter, machine$(1), n, m, rule
m = len(tape$)
n = token(mach$, machine$(), ",")
state$ = machine$(initState)
n = n - blank
headPos = 1
print "\n\n", machine$(name)
print string.rep$("=", len(machine$(name))), "\n"
if not countOnly print " State", "\t| Tape [head]\n----------------------"
repeat
if mid$(tape$, headPos, 1) = " " mid$(tape$, headPos, 1) = machine$(blank)
if not countOnly show(state$, headPos, tape$)
for rule = blank + 1 to n step 5
if machine$(rule) = state$ and machine$(rule + 1) = mid$(tape$, headPos, 1) then
mid$(tape$, headPos, 1) = machine$(rule + 2)
if machine$(rule + 3) = "left" then
headPos = headPos - 1
if headPos < 1 then
headPos = 1
tape$ = " " + tape$
end if
end if
if machine$(rule + 3) = "right" then
headPos = headPos + 1
if headPos > m then
m = m + 1
tape$ = tape$ + " "
end if
end if
state$ = machine$(rule + 4)
break
end if
next
counter = counter + 1
until(state$ = machine$(endState))
if countOnly then print "Steps taken: ", counter else show(state$, headPos, tape$) end if
end sub
// Main procedure
UTM(incrementer$, "111")
UTM(threeStateBB$, " ")
UTM(fiveStateBB$, " ", countOnly)

Some files were not shown because too many files have changed in this diff Show more