構文解析は, HaskellのParsecや, trampoline, OpenNPLを今まで使ってきましたが, 今回はGaucheのPegを使って構文解析してみようと思います.
Pegとは, Parser Expression Grammarの略で, 従来のパーサジェネレータ等に対して, 近年(Wikipediaには2002年の論文へのリンクが貼ってありますが...)登場した新しいタイプの形式言語で構文解析などに用いられます. 従来のCFG(文脈自由言語)に対して, 曖昧さが無く, 文法をそのまま再帰的下向き構文解析として用いることができるそうです. 理由は, 強欲な(Greedy)先読みを行うためで, 読み込めるまで優先順位の高い規則を使って読み込み, 失敗したらバックトラックにより戻ります. また, Greedyなために左再帰を用いた記述はできません.
GaucheでのPegは, パーサコンビネータとして実装されています. 使い方は次のように使えます.
gosh> (use parser.peg)
#<undef>
gosh> (peg-parse-string ($or ($s "1") ($s "2")) "2")
"2"
gosh> (peg-parse-string ($seq ($s "L") ($or ($s "L(1)") ($s "R"))) "LR")
"R"
gosh> (peg-parse-string ($seq ($s "L") ($or ($s "L(1)") ($s "R"))) "Peg")
*** PARSE-ERROR: expecting L at 0, but got #\P
Stack Trace:
_______________________________________
0 (eval expr env)
At line 179 of "c:\\Program Files (x86)\\Gauche\\share\\gauche-0.9\\0.9.4\\lib/gauche/interactive.scm"
高階関数の組み合わせにより文法を定義し, peg-parse-stringへ文法を定義した高階関数とターゲットとなる文字列を渡すと, 構文解析結果(最後にパースされた文字列?)が帰ってきます. エラー処理を何もしなかった場合, 上記のようにreplのトップにエラーが出力されました.$sとは引数に与えた文字列をパースせよという意味です. それに対して, $orは, 引数に与えられた各要素について, 先頭から順に調べて行って, どれか一つにマッチしたらOKという意味でしょう.
もう少し, 返される文字列を工夫したいという場合は, $doと$returnが使えます.
gosh> (peg-parse-string ($do [word ($or ($s "a") ($s "b"))] ($return word)) "b") "b"もう少し, 返される文字列を加工したいという場合は, rope->stringが使えます.
gosh> (peg-parse-string ($do [word ($or ($s "a") ($s "b"))] ($return (string-append "the answer is " (rope->string word)))) "b") "the answer is b"$do構文中では, 変数wordに解析結果(呼び出した関数から返される値)をバインドし, $returnでその文法が返す値を決めることができますが, 変数wordから文字列を取り出すには, rope->stringという関数に一回通す必要があります.
見た感じHaskellのParsecによく似ていますが, Comparision of parser generators - Wikipeida によれば, Parsecは, Deterministic CFGのリストにあり, アルゴリズムは, LL+Backtrackingと書かれているため, Pegとはまた別物のようです.
さて, 本題ですが, 漢数字の表記("一億千七百六十五万四千二百二十一"みたいなの)をパースして, 読みやすいアラビア数字の表記に変換します.
漢数字の表記で特徴的なのは, 千の位まででひと塊になること, 一万単位で新しい位に名前が付くことで, 一万, 一億, 一兆, ...etcといった感じになることです.
10未満を表す漢数字は当然, 次のようになります.
A → "一" | "二" | ... | "九"
0は入りません. 次に100未満を表す文法は, 以下のように記述できます.
A' → "二" | ... | "九"
B10 → A' "十" A | A' "十" | "十" A | A
十の前後に漢数字が入ってくるケース, 九十九などか, 1の位が記述されない九十, 単体の十, 十の位が記されない九など. 基本的にこれ以降の位でも同様のことが起きます. 得に紛らわしいのは, "二十"と書いても, "一十"とは書かないことで, 2～9までの漢数字を表すA'が別途必要になります. 100と1000の位は以下.
B100 → A' "百" B10 | A' "百" | "百" B10 | B10
B1000 → A' "千" B100 | A' "千" | "千" B100 | B100
こんな感じで, ただし, 百と千の後ろはそれぞれ, 百未満の数字, 千未満の数字を表す非終端記号が入ってきます. 前述したように, 一万を超えると, 千の位まででひと塊で, 一千万など位を表す漢数字の前に1～9999までの漢数字が入ってきます.
Cm → B1000 "万" B1000 | B1000 "万" | B1000
Co → B1000 "億" Cm | B1000 "億" | Cm
億以降は同じことの繰り返しになるので, 省略します.
似たような構造が続くので, もう少し簡潔に書けそうな気がしますが, 一つ間違えれば, 九十九十九みたいな文字を認識してしまうので, 各位の判定には注意が必要になります. 必ず億の次に万が来るように.
ただし, 細かい話をすれば, 一千万と言っても, 千万とは言わないとか, 億千万とはいうけど, この時の億千万とは, 多分, 一億一千万のことではないとか...
というわけで以上のCFGをまとめると以下の様になります.
Top → Cm | "零"
Cm → B1000 "万" B1000 | B1000 "万" | B1000
Co → B1000 "億" Cm | B1000 "億" | Cm
B1000 → A' "千" B100 | A' "千" | "千" B100 | B100
B100 → A' "百" B10 | A' "百" | "百" B10 | B10
B10 → A' "十" A | A' "十" | "十" A | A
A' → "二" | ... | "九"
A → "一" | "二" | ... | "九"
似たようなタイプ別に, A, B, C,とその添字でまとめています. このくくりは実装で関数としてまとめる単位別にA, B, Cとなっています.
おそらく, この漢数字による数値表現は, CFGを使わなくても, 正規表現(有限状態オートマトン)で十分認識可能だとは思われますが, 今回は一応, Schemeの数値型へ変換するということで, Pegを使っています.
(use parser.peg) ;; for parser
(use gauche.generator) ;; for test
(use srfi-1)
(use data.random) ;; for test
;; target characters :: 零一二三四五六七八九十百千万億
(define cc-0-9
(string->list "零一二三四五六七八九"))
;; from chinease character number format to natural number (integer type)
(define cc-num->nn
(let ((corresp (apply hash-table (cons 'eq? (zip cc-0-9 (iota 10))))))
(lambda (cc-num)
(car (ref corresp cc-num)))))
(define parse-Ad
($do [c ($or ($s "二") ($s "三") ($s "四") ($s "五")
($s "六") ($s "七") ($s "八") ($s "九"))]
($return (cc-num->nn (car (string->list (rope->string c)))))))
(define parse-A
($do ($or ($do [v ($c #\一)] ($return 1))
parse-Ad)))
(define parse-B
(lambda (head middle tail value)
($or
($try ($do [v10 head] [temp middle] [v1 tail] ($return (+ (* v10 value) v1))))
($try ($do [temp middle] [v1 tail] ($return (+ value v1))))
($try ($do [v10 head] [temp middle] ($return (* v10 value))))
($try ($do [v1 tail] ($return v1)))
($try ($do [temp middle] ($return value))))))
(define parse-B10
(parse-B parse-Ad ($s "十") parse-A 10))
(define parse-B100
(parse-B parse-Ad ($s "百") parse-B10 100))
(define parse-B1000
(parse-B parse-A ($s "千") parse-B100 1000))
(define parse-C
(lambda (head middle tail value)
($or
($try ($do [v10 head] [temp middle] [v1 tail] ($return (+ (* v10 value) v1))))
($try ($do [v10 head] [temp middle] ($return (* v10 value))))
($try ($do [v1 tail] ($return v1))))))
(define parse-Cm
(parse-C parse-B1000 ($s "万") parse-B1000 10000))
(define parse-Co
(parse-C parse-B1000 ($s "億") parse-Cm 100000000))
(define parse-top
($or ($do [temp ($s "零")] ($return 0))
($try parse-Co)
($return "faild to parse")))
(define (parse-cc-num cc-num)
(peg-parse-string parse-top cc-num))
;; from natural number (integer type) to chinease character number format
(define nn-num->4unit-list
(let ()
(define char->number
(let ((zero (char->integer #\0)))
(lambda (c)
(- (char->integer c) zero))))
(define num->cc-num
(let ((corresp (apply hash-table (cons 'eq? (zip (iota 10) cc-0-9)))))
(lambda (num)
(string (car (ref corresp num))))))
(define (each-unit value unit)
(cond
((= value 0) "")
((and (= value 1) (or (equal? unit "百") (equal? unit "十"))) unit)
(else (string-append (num->cc-num value) unit))))
(define zeros (circular-list 0))
(define lim 12) ;; 0 ~ 9999,9999,9999 (maximum length of string is 12)
(define unit '("千" "百" "十" ""))
(define 3units (append unit unit unit)) ;; (千 ~) 億 (千 ~) 万 (千 ~) 一
;; nn-num->4unit-list
(lambda (nn-num) ;; natural number (supposed to be integer type)
(let* ((nn-nlist (map char->number (string->list (number->string nn-num))))
(rest (- lim (length nn-nlist))))
(if (< rest 0)
(map each-unit (take zeros lim) 3units)
(map each-unit (append (take zeros rest) nn-nlist) 3units))))))
(define 4unit-list->cc-num
(let ()
(define (take&concat ls index)
(apply string-append (take-right (take ls (* index 4)) 4)))
(define (wipe-out-blanks unit-str cc-unit-name)
(if (equal? unit-str "") ""
(string-append unit-str cc-unit-name)))
;; 4unit-list->cc-num
(lambda (4unit-list)
(string-append
(wipe-out-blanks (take&concat 4unit-list 1) "億") ;; oku
(wipe-out-blanks (take&concat 4unit-list 2) "万") ;; man
(wipe-out-blanks (take&concat 4unit-list 3) "")))));; ichi
(define (nn->cc-num n)
(4unit-list->cc-num (nn-num->4unit-list n)))
;; test
;; int -> int
(define id
(lambda (x)
(parse-cc-num (nn->cc-num x))))
(define (do-test n) ;; n = the number of repeat
(call/cc
(lambda (cc)
(map (lambda (value)
(if (not (= value (id value)))
(cc (format "fail to parse ~D" value))))
(generator->list (integers-between$ 0 1000000000000) n))
(display "all tests passed"))))
parse-B, parse-C関数にある$tryの部分は, 強欲な読み込みの裏返しで, 読み込みが失敗した時に, $tryの位置まで戻ってくることを指しているようで, Javaのtry-catchのようなものでしょうか.nn->cc-numは, ちょうど解析器の(おおよその)逆関数になっていて, 数値を入力として受け取り, 漢数字を返します. 若干不十分なところはありますが(例えば, 入力1000について, 千ではなく, 一千と返してしまいます).
gosh> (nn->cc-num 1000) "一千" gosh> (nn->cc-num 1290123139) "十二億九千十二万三千百三十九" gosh> (nn->cc-num 1290000009) "十二億九千万九"というわけでParserを実際に動かしてみると, こんな感じに認識してくれることがわかります.
gosh> (parse-cc-num "十二億九千十二万三千百三十九") 1290123139 gosh> (parse-cc-num "十二億九千万九") 1290000009 gosh> (do-test 1000) all tests passed#