読者です 読者をやめる 読者になる 読者になる

レガシーコード生産ガイド

私に教えられることなら

SchemeでNFA→DFA変換を書いた

(7/17追記 タイトルその他ほとんど間違えてDFA→NFA変換と書いていました NFA→DFA変換ですね)

最近、前々から気になっていたオートマトンについて「はじめて学ぶオートマトンと言語理論」という本で学習しています。読んでいるうちに実際にオートマトンとNFA→DFA変換を動かしてみたくなったので、Scheme(Gauche)で書いてみました。ついでに、あるNFA→DFA変換問題(演習3.4のb)の答えが間違っていると判断したので、その確認も簡単にできるようにグラフ画像も出力します。

NFA→DFAの変換アルゴリズム自体の説明は大量にあるので省略します。プログラムを書く上で思った事と、出来上がったコードと出力された画像を載せます。

プログラムを書く上で思った事

変換アルゴリズムでは、状態集合の集合を扱う必要があります。最初は頭の中だけで考えて書いていましたが、現在対象としているのが集合なのか集合の集合なのか混乱してしまいました。これは特にどの集合なのかを明確にしてアルゴリズムを紙に書くことで簡単に解決しました。またset-of-set-of-stateのような冗長な変数名ではなく、単純にSなどの短い名前を使ったほうがわかりやすくなりました。

次にデータ構造についてです。最初はDFAを状態遷移させるコードから書きました。状態や入力はシンボル又は数で表し、遷移関数はリストで次のように与えることにしました。

([q0 (a q1) (b q2)]
 [q1 (b q2)]
 [q2])

そして状態遷移内部では二重ハッシュテーブルに変換して使いました。遷移元状態をキーとしたハッシュテーブル(a)に、入力記号がキーで遷移先状態が値のハッシュテーブル(b)を格納します。

しかしNFAでは同じ入力記号に対して複数の遷移先が存在可能なため、(b)のハッシュテーブルでは表現できません。上書きされてしまいます。

結局NFA→DFA変換やグラフ用の処理でやや遠回りになりました。処理の内容を眺めてみると、NFAもDFAも次のようなデータで保持したほうが良さそうです。

([q0 a q1] [q0 b q2] [q1 b q2])

まず何よりも上手くデータ構造を設計することが大事、と改めて感じました。その後のコードの複雑さやそれが生み出す作業時間を大幅に減らせます。

最後に副作用とテストについてです。最初は副作用を使わずに上手く書こうと四苦八苦していました。しかし慣れていないためかツリー的な再帰でわけがわからなくなりました。途中できっぱり諦め、状態集合などをどんどん書き換えていくコードにしたところ、あっけなく数十分で書き上がりました。特にデバッグなども苦労しませんでした。また、テストを書いてしっかり歩んでいこうとしましたが、テストを書くには簡単すぎるか、テストを書くのが難しすぎるかのどちらかばかりで、馬鹿らしくなって止めてしまいました。

現時点では、

  • map/reduceで簡単に書けるようなコードはできるだけ非破壊的に書く
  • 非破壊的にするためだけに複雑なコードになるぐらいなら破壊的に書く
  • 大きな変換についてのみテストを書く。例えばコンパイラならコンパイル前→結果ぐらい
  • 専用のREPLなどからテストを自動生成できるもののみ書く

ぐらいの塩梅が精神的にはちょうど良さそうです。

全て非破壊的に書こうとする人、もっと細かくテストを書いて大胆に破棄していく人、などもいるようですが、私にはちょっと向いてなさすぎると痛感しています。同じように感じる人が居たら身を寄せあいたいところです。

グラフ画像

件の問題(演習3.4のb)の変換前NFAとDFAです。p166の解答の方は状態が4個ですが、変換後は5個になりました。

f:id:phaendal:20160717015716p:plain

f:id:phaendal:20160717015723p:plain

コード

使用した処理系はGaucheです。Gaucheのオブジェクトシステムを利用しています。

この記事を書いた時点では、GitHubリポジトリにいくつかのサンプルも載せた版があります。

(use srfi-1)
(use gauche.interactive)
(use gauche.collection)
(use gauche.process)

;; Utilities
;; =============================================================================
;; Set
(define set=         (pa$ lset= eq?))
(define adjoin       (pa$ lset-adjoin eq?))
(define union        (pa$ lset-union eq?))
(define intersection (pa$ lset-intersection eq?))
(define set-union    (pa$ lset-union set=))

;; Assocs
(define (assocs->table f assocs)
  (let* ([table (make-hash-table)])
    (for-each
     (lambda [assoc]
       (hash-table-put! table (car assoc) (f (cdr assoc))))
     assocs)
    table))

;; DFA
;; =============================================================================
(define-class <dfa> ()
  ((states      :init-keyword :states      :accessor states-of)
   (inputs      :init-keyword :inputs      :accessor inputs-of)
   (transitions :init-keyword :transitions :accessor transitions-of)
   (start       :init-keyword :start       :accessor start-of)
   (accepts     :init-keyword :accepts     :accessor accepts-of)))

(define (show-dfa dfa)
  (for-each
   (lambda [x] (format #t "~7A: ~S~%" (car x) (cadr x)))
   `((states  ,(states-of dfa))
     (inputs  ,(inputs-of dfa))
     (start   ,(start-of dfa))
     (accepts ,(accepts-of dfa)))))

(define (create-transitions xs)
  (assocs->table
   (lambda [assocs] (assocs->table car assocs))
   xs))

(define (revert-transition-table table)
  ;; 二重ハッシュリストの遷移関数テーブルを、(q0 (a q1) (b q2))の形にして返す。
  (hash-table-map
   table
   (lambda [from tbl]
     (cons from
           (hash-table-map
            tbl
            (lambda [input val] (list input val)))))))

(define (transition dfa state input)
  (let* ([ts (hash-table-get (transitions-of dfa) state (undefined))])
    (unless (undefined? ts)
      (hash-table-get ts input (undefined)))))

(define (accept-state? dfa state)
  (pair? (member state (accepts-of dfa))))

(define (thru-transition state input next) next)

(define (run-with dfa inputs f)
  (fold (lambda [input state]
          (f state input (transition dfa state input)))
        (start-of dfa)
        inputs))

(define (run dfa inputs) (run-with dfa inputs thru-transition))

(define (accept? dfa inputs)
  (accept-state? dfa (run dfa inputs)))

(define (run-pp dfa inputs)
  (define (pp state input next)
    (format #t ";;   ~5S -(~S)-> ~5S~%" state input next)
    next)
  (format #t ";; <inputs> ~S~%" inputs)
  (let* ([final (run-with dfa inputs pp)])
    (print
     (if (accept-state? dfa final)
         ";; <accept>"
         ";; <failed>"))))

;; NFA to DFA
;; =============================================================================
(define-class <nfa> (<dfa>) ())

(define (nfa>dfa nfa)
  (let* ([states      (states-of nfa)]
         [inputs      (inputs-of nfa)]
         [transitions (transitions-of nfa)]
         [start       (start-of nfa)]
         [accepts     (accepts-of nfa)]
         ;; NFAは重複を許すので、遷移テーブルは連想リストをそのまま持つ
         [table (assocs->table identity transitions)]
         ;; 初期状態を状態集合にしておく
         [starts (list start)]
         ;; 全ての状態集合の集合
         [Q (list starts)]
         ;; 全ての状態集合と入力からの遷移関数。(S i S1) のリスト
         [D '()])
    (define (tran-states s i)
      ;; 状態sから、入力iによって遷移する状態の和集合を返す。
      (let* ([ts (hash-table-get table s '())])
        (if (null? ts) ts
            (map cadr
                 (filter (lambda [assoc] (eq? (car assoc) i)) ts)))))
    (define (tran-set S i)
      ;; 状態集合Sのそれぞれの状態sについて、入力iによって遷移する状態s1の
      ;; 和集合S1を返す。
      (apply union (map (lambda [s] (tran-states s i)) S)))
    (define (save-delta S i S1) (set! D (cons (list S i S1) D)))
    (define (memQ S1) (find (lambda [S] (set= S S1)) Q))
    (define (?save-S1 S1)
      ;; S1がQに含まれていなければ、Qに上書きで追加して#tを返す。
      ;; 含まれていれば#fを返す。
      (if (memQ S1) #f (begin (set! Q (cons S1 Q)) #t)))
    (define (convert S i)
      ;; 状態集合Sと入力iについて、遷移する状態集合S1がQに含まれていれば終了。
      ;; そうでなければ、遷移関数を記録し、全ての状態集合の集合QにS1を追加して
      ;; S1について(相互)再帰する。
      (let* ([S1 (tran-set S i)])
        (save-delta S i S1)
        (when (?save-S1 S1) (convert-each S1))))
    (define (convert-each S) (for-each (pa$ convert S) inputs))
    ;; -----<番号付け>-----
    (define (number-of Q S)
      ;; 番号付けられたQから、状態集合Sの番号を引く
      (cadr (find (lambda [assoc] (set= (car assoc) S)) Q)))
    (define (numbered-delta Q d)
      ;; 状態遷移関数dの状態を前後どちらも番号にしたものを返す
      (list (number-of Q (first d))
            (second d)
            (number-of Q (third d))))
    (define (collect-accepts)
      ;; 受理状態を含む状態集合を集める
      (remove (lambda [S] (null? (intersection S accepts))) Q))
    (define (create-transtable ts)
      (let* ([table (make-hash-table)])
        (define (add s i s1)
          (hash-table-update! table s
                              (lambda [tbl] (hash-table-put! tbl i s1) tbl)
                              (make-hash-table)))
        (for-each (lambda [trans] (apply add trans)) ts)
        table))
    (define (create-dfa)
      (let* ([accepts (collect-accepts)]
             ;; 状態は全て番号
             [states (iota (length Q))]
             ;; 状態集合の集合Qを番号と対応させる
             [Q (zip Q states)]
             ;; 状態遷移関数を全て番号化して、DFA用テーブルに
             [transitions (map (pa$ numbered-delta Q) D)]
             [transitions (create-transtable transitions)]
             ;; 初期状態を番号化
             [start (number-of Q starts)]
             ;; 受理状態の集合を番号に修正
             [accepts (map (pa$ number-of Q) accepts)])
        (make <dfa>
          :states states :inputs inputs :transitions transitions
          :start start :accepts accepts)))
    ;; -----<実際の処理>-----
    (convert-each starts)
    (create-dfa)))

;; Graphviz
;; =============================================================================
(define-method print-graph (inputs transitions start accepts)
  (define (print-arrow from input to)
    (format #t "~A -> ~A [ label = \"~A\" ];~%" from to input))
  (print "digraph finite_automaton {")
  (print "rankdir=LR;")
  (print "\"\" [shape = none];") ; 初期状態の矢印
  ;; 受理状態
  (format #t "node [shape = doublecircle]; ~A;~%"
          (string-join (map (cut format #f "~A" <>) accepts) " "))
  (print "node [shape = circle];") ; 他の状態
  ;; 初期状態
  (print-arrow "\"\"" "" start)
  ;; ノード
  (for-each
   (lambda [row]
     (let* ([from (car row)])
       (for-each
        (lambda [assoc]
          (print-arrow from (car assoc) (cadr assoc)))
        (cdr row))))
   transitions)
  (print "}"))

(define-method print-graph ((nfa <nfa>))
  (print-graph
   (inputs-of nfa)
   (transitions-of nfa)
   (start-of nfa)
   (accepts-of nfa)))

(define-method print-graph ((dfa <dfa>))
  (print-graph
   (inputs-of dfa)
   (revert-transition-table (transitions-of dfa))
   (start-of dfa)
   (accepts-of dfa)))

(define (save-graph automaton filebase :optional (save-dot? #f))
  (let* ([dot (string-append filebase ".dot")]
         [png (string-append filebase ".png")])
    (with-output-to-file dot (lambda [] (print-graph automaton))
                      :if-exists :supersede
                      :if-does-not-exist :create)
    (run-process `(dot -Tpng ,dot -o ,png) :wait #t)
    (unless save-dot? (run-process `(rm ,dot)))))

;; Example
;; =============================================================================
(let* ([nfa1 (make <nfa>
               :states  '(p0 p1 p2 p3)
               :inputs  '(a b)
               :start   'p0
               :accepts '(p3)
               :transitions
               '([p0 (a p0) (a p1) (b p0) (b p2)]
                 [p1 (b p3)]
                 [p2 (a p3)]
                 [p3]))]
       [dfa1 (nfa>dfa nfa1)])
  (save-graph nfa1 "nfa1")
  (save-graph dfa1 "dfa1")
  (newline)
  (show-dfa dfa1)
  (run-pp dfa1 '(a b b a b)))
広告を非表示にする