Skip to content

Instantly share code, notes, and snippets.

@tormaroe
Created December 9, 2010 07:50
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tormaroe/734458 to your computer and use it in GitHub Desktop.
Save tormaroe/734458 to your computer and use it in GitHub Desktop.
(ns turing.core)
(comments "The turing machine runs on a table of rules defined by 5-tuples,
implemented here as maps with the following format:"
{ :tape value ; Given cell under head has value
:state value ; And machine state has value
:write value ; Then write value in cell
:move value ; Move head according to value (:left :right :no)
:set-state value }) ; And set new machine state to value
(def *initial-state* "A")
(def *empty-cell* 0)
(def halt "HALT")
(defn find-rule
"Find the rule for current state and symbol"
[symbol state rules]
(first (filter (fn [r] (and (= (r :tape) symbol)
(= (r :state) state)))
rules)))
(defn move-type
"Return the type of tape move to perform. If the move is to a
previously unvisited cell, the tape needs to be expanded, so
this function should return :off-left or :off-right."
[tape head-position rule]
(let [dir (rule :move)]
(cond (and (= head-position 0)
(= dir :left))
:off-left
(and (= (+ 1 head-position) (count tape))
(= dir :right))
:off-right
:else dir)))
(defn perform-move
"Returns a two element vector with new tape and new position"
[tape head rule]
(let [tape2 (assoc tape head (rule :write))]
(case (move-type tape head rule)
:off-right [(conj tape2 *empty-cell*) (inc head)]
:off-left [(vec (cons *empty-cell* tape2)) head ]
:right [tape2 (inc head)]
:left [tape2 (dec head)]
:no [tape2 head ])))
(def tableformat "%10s %7s %10s %s%n")
(defn run
"Run turing machine by given rules and print each step.
Initial state is \"A\", empty cell symbol is 0."
[rules]
(printf tableformat "Sequence" "State" "Position" "Tape")
(loop [i 1, state *initial-state*, tape [*empty-cell*], head 0]
(printf tableformat i state head tape)
(when (not= state halt)
(let [rule (find-rule (nth tape head)
state
rules)
[tape2 head2] (perform-move tape
head
rule)]
(recur (inc i)
(rule :set-state)
tape2
head2)))))
;; Set up and run Turing table for 3-state Busy Beaver
(run [{ :tape 0 :state "A" :write 1 :move :right :set-state "B" }
{ :tape 0 :state "B" :write 1 :move :left :set-state "A" }
{ :tape 0 :state "C" :write 1 :move :left :set-state "B" }
{ :tape 1 :state "A" :write 1 :move :left :set-state "C" }
{ :tape 1 :state "B" :write 1 :move :right :set-state "B" }
{ :tape 1 :state "C" :write 1 :move :no :set-state halt }])
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment