I dag blir det ikke en helt vanlig luke i kalenderen. I går inspirerte jeg nemlig meg selv såpass ved å fortelle om Alan Turing at jeg ble nødt til å implementere min egen lille Turingmaskin. Folk kaller meg merkelig, men det får nå bare være :)

Denne luken er nok dermed ment for et litt smalere publikum enn vanlig. Det kan f.eks. godt tenkes du ønsker å lese deg opp på turingmaskiner for å få mest utbytte av dette. Jeg planlegger derimot å komme tilbake med en vanlig luke i morgen, så fortvil ikke!

Denne koden er forresten implementert i sånn passe trøtt tilstand, delvis på bussen, så den kan helt sikkert forbedres. Hvis du tror at du kunne klart bedre – og du kan velge programmeringsspråk selv – så utfordrer jeg deg til å dele koden din i kommentarfeltet. Jeg er nemlig veldig interessert i å se andre implementasjoner a turingmaskiner. MEN IKKE POST KODEN DIREKTE I KOMMENTARFELTET, lim heller koden din inn på pastie, Gist eller lignende, og link til koden i kommentaren din her.

Koden min er forresten tilgjengelig i sin helhet som gist her. I denne artikkelen presenteres koden stykkevist og delt..

Hvordan representere en turingmaskin

Jeg valgte selvsagt å bruke Clojure for å implementere min første Turingmaskin. Den er basert på en tabell med regler som består av fem verdier: Hva som står i tapecellen under lesehodet, hvilken tilstand maskinen er i, hva som skal skrives, hvilken retning man skal flytte, og hvilken ny tilstand maskinen skal settes i.

 1 (ns turing.core)
 2 
 3 (comments "The turing machine runs on a table of rules defined by 5-tuples,
 4            implemented here as maps with the following format:"
 5         { :tape value                 ; Given cell under head has value
 6           :state value                ; And machine state has value 
 7           :write value                ; Then write value in cell 
 8           :move value                 ; Move head according to value (:left :right :no) 
 9           :set-state value })         ; And set new machine state to value

Så definerer jeg noen variabler for initiell tilstand, default-verdien til en celle, og det spesielle symbolet for når maskinen skal stoppe.

11 (def *initial-state* "A")
12 (def *empty-cell* 0)
13 (def halt "HALT")

Her følger funksjonen for å finne riktig regel som skal brukes for en gitt tilstand og et gitt symbol under lesehodet på tapen.

15 (defn find-rule
16       "Find the rule for current state and symbol"
17       [symbol state rules]
18       (first (filter (fn [r] (and (= (r :tape) symbol)
19                                   (= (r :state) state)))
20                      rules)))

Og så trenger jeg en litt spesiell funksjon som kan fortelle meg litt om hvilken type bevegelse jeg skal gjøre på tapen. Jeg vil nemlig bruke en vektor (array) til å representere tapen, og vil da få behov for å kjøre litt spesiell kode hvis maskinen ønsker å bevege seg utenfor vektorens størrelse – enten den ene eller den andre veien. Funskjonen skal altså fortelle meg om ny index/posisjon vil bli enten –1 eller går utenfor vektorens lengde.

22 (defn move-type
23       "Return the type of tape move to perform. If the move is to a
24       previously unvisited cell, the tape needs to be expanded, so
25       this function should return :off-left or :off-right."
26       [tape head-position rule]
27       (let [dir (rule :move)]
28         (cond (and (= head-position 0)
29                    (= dir :left))
30                 :off-left
31               (and (= (+ 1 head-position) (count tape))
32                    (= dir :right))
33                 :off-right
34               :else dir)))

Jeg kan nå presentere funksjonen for å gjennomføre en bevegelse på tapen basert på en regel. Funksjonen produserer en ny tape – potensielt med flere celler om det er nødvendig – og oppdaterer også posisjonen.

36 (defn perform-move
37       "Returns a two element vector with new tape and new position"
38       [tape head rule]
39       (let [tape2 (assoc tape head (rule :write))]
40         (case (move-type tape head rule)
41           :off-right [(conj tape2 *empty-cell*)       (inc head)]
42           :off-left  [(vec (cons *empty-cell* tape2)) head      ]
43           :right     [tape2                           (inc head)]
44           :left      [tape2                           (dec head)]
45           :no        [tape2                           head      ])))

Og så har vi endelig ankommet til funskjonen som skjører maskinen. Run starter opp med initiell tilstand og en tom celle. Den finnes så hvilken regel som skal brukes for å gå til neste tilstand (linje 57), utfører operasjonen på tapen (linje 60), og looper (via halerekursjon) inntil den spesielle halt-tilstanden blir satt.

47 (def tableformat "%10s %7s %10s %s%n")
48 
49 (defn run
50       "Run turing machine by given rules and print each step.
51       Initial state is \"A\", empty cell symbol is 0."
52       [rules]
53       (printf tableformat "Sequence" "State" "Position" "Tape")
54       (loop [i 1, state *initial-state*, tape [*empty-cell*], head 0]
55             (printf tableformat i state head tape)
56             (when (not= state halt)
57               (let [rule (find-rule (nth tape head)
58                                     state
59                                     rules)
60                     [tape2 head2] (perform-move tape
61                                                 head
62                                                 rule)]
63                 (recur (inc i)
64                        (rule :set-state)
65                        tape2
66                        head2)))))

Ivrig Bever

Jeg skal nå kunne kjøre turingmaskinen min, og velger da et lite program jeg finner på wikipedia som kalles en 3-state Buzy Beaver. Konseptet om ivrige bevere er veldig akademisk, men den er i alle fall ikke vanskelig å sette opp nå som jeg har implementert turingmaskinen min. Her er kallet til Run som vil kjøre maskinen med bever-reglene.

68 ;; Set up and run Turing table for 3-state Busy Beaver
69 (run [{ :tape 0 :state "A" :write 1 :move :right :set-state "B"   }
70       { :tape 0 :state "B" :write 1 :move :left  :set-state "A"   }
71       { :tape 0 :state "C" :write 1 :move :left  :set-state "B"   }
72       { :tape 1 :state "A" :write 1 :move :left  :set-state "C"   }
73       { :tape 1 :state "B" :write 1 :move :right :set-state "B"   }
74       { :tape 1 :state "C" :write 1 :move :no    :set-state halt  }])

Og her er resultatet:

user=> (require 'turing.core :reload)
  Sequence   State   Position Tape
         1       A          0 [0]
         2       B          1 [1 0]
         3       A          0 [1 1]
         4       C          0 [0 1 1]
         5       B          0 [0 1 1 1]
         6       A          0 [0 1 1 1 1]
         7       B          1 [1 1 1 1 1]
         8       B          2 [1 1 1 1 1]
         9       B          3 [1 1 1 1 1]
        10       B          4 [1 1 1 1 1]
        11       B          5 [1 1 1 1 1 0]
        12       A          4 [1 1 1 1 1 1]
        13       C          3 [1 1 1 1 1 1]
        14    HALT          3 [1 1 1 1 1 1]
nil

Er det ikke vakkert?! ;)

Kategorier: Julekalender, LISP/Clojure.
RSS feed for kommentarene. Tilbaketråkk.