One of the foundational mathematical constructs behind computer science
is the 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 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)


The input for this machine should be a tape of 1 1 1


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)


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)


The input for this machine should be an empty tape.

This machine runs for more than 47 millions steps.




program project1;
uses
 Classes, sysutils;

type
 TCurrent = record
   state : string;
   input : char;
 end;

 TMovesTo = record
   state : string;
   output : char;
   moves : char;
 end;

 var
   ST, ET: TDateTime;
   C:TCurrent;
   M:TMovesTo;
   Tape, Rules:TStringList;
   TP:integer; //TP = Tape position
   Blank : char;
   j:integer;
   FinalState, InitialState, R : string;
   Count:integer;

Function ApplyRule(C:TCurrent):TMovesTo;
var
  x,k:integer;
begin
  //Find the appropriate rule and pass it as the result
  For k:= 0 to Rules.Count-1 do
  begin
     If (k mod 5 = 0) and (Rules[k] = C.state) and (Rules[k+1] = C.input) then
     begin
         Result.output := Rules[k+2][1];
         Result.moves := Rules[k+3][1];
         Result.state := Rules[k+4];
     end;
  end;
end;

Procedure ChangeTape(var TapePosition:integer;N:TMovesTo);
begin
   Tape[TapePosition]:=N.output;
   Case N.moves of
   'l':begin
         TapePosition := TapePosition-1;
       end;
   'r':begin
         TapePosition := TapePosition+1;
       end;
   end;
end;

function GetInput(TapePosition:integer):char;
begin
  Result:=Tape[TapePosition][1];
end;

procedure ShowResult;
var
  k:integer;
begin
  writeln('Current State  :',C.state);
  writeln('Input          :',C.input);
  write(' Tape ');
  For k:= 0 to Tape.count-1 do
  begin
     write(Tape[k]);
  end;
  writeln;
  writeln('New    State  :',M.state);
  writeln('Tape position :',TP);
  writeln('-----------------------');
end;

begin
  writeln('Universal Turing Machine');
  writeln('------------------------');
  Count:=0;
  ST:=Time;

  //Set up the rules
  Rules := TStringList.create;
  R := 'q0,1,1,right,q0,q0,B,1,stay,qf';
  Rules.CommaText := R;
  InitialState := 'q0';
  FinalState := 'qf';

  //Set up the tape
  Tape:=TStringList.create;
  Tape.add('1');
  Tape.add('1');
  Tape.add('1');
  Blank := 'B';
  For j:= 1 to 10 do
  begin
     Tape.add(Blank);
  end;

  //Set up the initial state
  writeln('Initial state');
  C.state:=InitialState;
  C.input:=' ';
  M.state:='';
  M.output:=' ';
  M.moves:=' ';
  TP:=0;

  //Run the machine
  While (TP >= 0) and (M.State <> FinalState) do
  begin
    C.Input := GetInput(TP);
    If M.state <> '' then
    begin
      C.State := M.State;
    end;
    M:=ApplyRule(C);
    ChangeTape(TP,M);
    Count:=Count+1;
    ShowResult;
  end;

  //State the outcome.
  If TP < 0 then
  begin
     writeln('Error! Tape has slipped off at left!');
  end;
  If M.state = FinalState then
  begin
     writeln('Program has finished');
     ET:=Time;
     writeln('Time taken ');
     writeln(FormatDateTime('sss:zzz',ET-ST));
     writeln(Count, ' steps taken');
  end;

  Tape.free;
  Rules.free;
  readln;
end.
