Created
December 9, 2010 07:50
-
-
Save tormaroe/734458 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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