torsdag 9. desember 2010 Julekalender Clojure
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..
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)))))
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?! ;)