374 lines
16 KiB
Plaintext
374 lines
16 KiB
Plaintext
;; "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
|