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.




 
;; "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
 