Theory of Computation #14

Now we want a function to move the head to the left and write:

(move-head 2 :right) -> 3
(move-head 2 :left) -> 1

Also not that hard:

(defn move-head
  "Moves the head to the direction by one."
  [position direction]
  (cond (= direction :left) (if (zero? position)
                              nil
                              (dec position))
        (= direction :right) (inc position)
        :else nil))

Here are all the tests so far:

(with-test
  (def tape [:a :b nil :a :a])

  (is (= (read-tape tape 0) :a))
  (is (= (read-tape tape 2) nil))
  (is (= (read-tape tape 6) nil))

  (is (= (write-tape tape 0 :c) [:c :b nil :a :a]))
  (is (= (write-tape tape 2 :a) [:a :b :a :a :a]))

  (is (= (move-head 0 :right) 1)) 
  (is (= (move-head 0 :left) nil))
  (is (= (move-head 3 :left) 2)))

Now we need to think about states. We have the current position of the head and the current state of the program.

The good thing is that we don’t need variables which can be accessed from everywhere, i.e. we can put these states without problems in our execution loop and bind them locally.

The last thing we need is the rule table. The rule table consists of rules which match with the current state and current symbol and perform a write and change in state.

We can represent that with a hash-map:

{:start 2
:symbol :b
:write :right
:end 3}

This rule for example is activated if the start state is 2 and the current symbol is :b. It moves the head to the right and moves to state 3. If write is neither :left or :right it writes the symbol in the current cell.

Similarly, we can describe our current machine state:

{:state 3
:head 2}

In this example the program state is 3 and the head is on position 2. I reserve state 0 to be the halting state.

 

Next part tomorrow

Theory of Computation #13

Exercise 3.1.1: With what tape configuration will the Turing machine represented below halt if it is started with its tape configured as _x_xx delta delta delta…?

ex3.1.I

A table works fine for going through that:
[table]Tape, State, Transition
_x_xxddd , 0, x/R
x_x_xddd , 1 , x/R
xx_x_ddd , 0 , x/R
xxx_d_dd , 1 , d/R
xxxd_d_d , 0 , d/d
xxxd_d_d , 2 , halt[/table]

Exercise 3.1.3: Design a Turing machine that, when started with its tape head over the leftmost tape cell, will suffer an abnormal termination if and only if and x is recorded somewhere on its tape. If you applied your machine to a tape that did not contain an x, would the machine ever detect that fact?

The idea is pretty basic. We start in a state and repeat a state which isn’t left in case no x is found. If a x is found it goes into a next state which just repeats going left over and over again.

In case there’s no x on the tape, the machine will go into an infinite look checking every cell of the infinite right side.

 

Exercise 3.6.1P: Develop a Turing machine simulator. Design the simulator so that the description of the machine to be simulated is provided in a tabular form that can be replaced easily by the description of another machine.

So, a Turing machine has the following features:

  • It has a tape which is infinite to the right, if nothing written on it then they are blank
  • It has a head which can write and write at the current tape cell
  • It has a state register which stores the current state
  • It has a table of instructions which take the state, the current symbol and tells the machine what to write and a new state

Let’s start with building the machine without the instruction table first. I.e. it can read, write and move it’s head.

The first thing we want it to do is read the current cell. The cell will be represented as a vector.

[:a :b nil :a :a]

This tape consists of a b blank a a. Our machine also needs to know its current head position.

(read-tape tape 0) -> :a
(read-tape tape 2) -> nil

This is rather easy:

(defn read-tape
  "Reads the position on a tape"
  [tape position]
  (try
    (tape position)
    (catch Exception e nil)))

Now, we need an option to write:

(write-tape tape 0 :c) -> [:c :b nil :a :a]

This is also very easy:

(defn write-tape
  "Returns an altered tape with value on position."
  [tape position value]
  (assoc tape position value))

Next part tomorrow

Theory of Computation #12

Let’s take the rules from the beginning.

A -> eAee
A -> fBf
B -> g

The result should be:

A -> FI
I -> BF

A -> EJ
J -> AK
K -> EE

B -> g

E -> e
F -> f

Here’s the final code which stitches together all our functions:

(defn shorten-loop
  "Applies shorten-rule on a collection of rules"
  [coll]
  (loop [rest-fix coll
         index (int \I)
         result nil]
    (if (seq rest-fix)
      (recur
       (rest rest-fix)
       (+ index (dec (count (shorten-rule (first rest-fix) (char index)))))
       (into result (shorten-rule (first rest-fix) (char index))))
      result)))




(defn to-CNF
  "Takes a vector of rules in context free regular form and returns them
   as a hashmap in Chomsky normal form (CNF)."
  [input-strings]
  (let [filter-fn #(check-CNF (first (vals %)))
        filter-good (partial filter filter-fn)
        filter-bad (partial remove filter-fn)
        decomposed-input (map decompose-rule input)
        mixed-terminals (set (mapcat transform-terminals
                                     (filter-bad decomposed-input)))]
    (set (reduce into 
                 [(filter-good decomposed-input)
                 (filter-good mixed-terminals)
                 (shorten-loop (filter-bad  mixed-terminals))]))))
         


(with-test
  (def input ["A -> eAee"
              "A -> fBf"
              "B -> g"])
  (is (= (to-CNF input)
         #{{:J "AK"} {:I "BF"} {:E "e"} {:K "EE"} {:A "EJ"} {:F "f"} {:A "FI"} {:B "g"}}#{{:J "AK"} {:I "BF"} {:E "e"} {:K "EE"} {:A "EJ"} {:F "f"} {:A "FI"} {:B "g"}})))

And the result is:

{:A "FI"}
{:I "BF"}

{:A "EJ"}
{:J "AK"}
{:K "EE"}

{:B "g"}

{:E "e"}
{:F "f"}

Yay. This took a while.

Theory of Computation #11

The next major step is to transform existing rules to CNF. We have to do two things:

A) Transform the terminals to new non-terminals
B) Shorten the rule

A) seems easier, so let’s do that first.

Examples: xA, By

In this case, we have to create a new variable – for the sake of simplicity its name will be the name of the terminal in uppercase – and replace it.

(transform-terminals "A -> xA") -> [{:A "XA"}, {:X "x"}]

Before that I need a function which decomposes the string.

(decompose-rule "A -> xA") -> {:A "xA"}

Here’s the code and test: (I edited the input later to directly take a decomposed map)

(defn decompose-rule
  "Takes a rule in the format A -> B and returns a hash-map
   containing the decomposed rule."
  [string]
  (let [[kw content] (clojure.string/split string #" -> ")]
    (hash-map (keyword kw) content)))


(deftest test-decompose
  (is (= (decompose-rule "A -> xA") {:A "xA"})) 
  (is (= (decompose-rule "B -> y") {:B "y"}))
  (is (= (decompose-rule "C -> yBz") {:C "yBz"})))

Ok, now we can concentrate on the right-side of the rules. Want we want the function from before:

(transform-terminals "A -> xA") -> [{:A "XA"}, {:X "x"}]

The idea is pretty basic. We extract each terminal, i.e. lower case, and create a new rule for that, afterwards we take the initial rule and uppercase everything.

(defn transform-terminals
  "Takes a decomposed map and generates new non-terminals for each terminal"
  [decomposed]
  (let [[name rule] (first decomposed)]
    (conj 
     (map
      #(hash-map (keyword (clojure.string/upper-case %))  (str %))
      (filter #(Character/isLowerCase %) rule))
     (hash-map name (clojure.string/upper-case rule)))))


(deftest test-transform
  (is (= (transform-terminals {:A "xA"})
         [{:A "XA"} {:X "x"}]))
  (is (= (transform-terminals {:B "xAy"})
         [{:B "XAY"} {:X "x"} {:Y "y"}])))

Now we have a list of rules which may be too long. Let’s take care of that.

For the sake of simplicity I will use variables A to H for existing rules. And everything higher than that for new rules which are needed for shortening the existing one.

Let’s say we have the following transformed rules:

{:A "CHC"}
{:B "DABA"}

What we want is:

{:A "CI"}
{:I "HC"}

{:B "DJ"}
{:J "AK"}
{:K "BA"}

Here’s the function to do that:

(defn shorten-rule
  "Takes a transformed rule and returns new ones"
  [hmap start-index]
  (let [[rname rule] (first hmap)
        length (count rule)
        num-sequence (iterate inc (int start-index))
        extra-indexes (apply str (map char (take (- length 2) num-sequence)))
        end-string (apply str (drop (- length 2) rule))]
    (loop [rule-string (str (apply str (interleave rule extra-indexes)) end-string)
           index (name rname)
           result nil]
      (if (seq rule-string)
        (recur
         (drop 2 rule-string)
         (second rule-string)
         (conj result
               (hash-map
                (keyword (str index))
                (apply str (take 2 rule-string)))))
        result))))


(deftest test-shorten
  (is (= (shorten-rule {:A "CHC"} \I)  
         [{:I "HC"} {:A "CI"}]))
  (is (= (shorten-rule {:B "ABCD"} \L)  
         [{:M "CD"} {:L "BM"} {:B "AL"}]))
  (is (= (shorten-rule {:C "BABA"} \O)  
         [{:P "BA"} {:O "AP"} {:C "BO"}])))

It works. So, now we need to put everything together.

Continue tomorrow