Kimura Fuyuki
fuyuk****@nigre*****
2003年 8月 15日 (金) 07:28:05 JST
真鵺道形式の差分を取る関数を書きました。もとはSKKの辞書メンテツールの 一部なのですが、べつにSKK に依存するわけではないので、こっちにも流して おきます。public domain なものとして扱ってください。 真鵺道についてはこちら。 http://www.archi.is.tohoku.ac.jp/~yamauchi/otherprojects/manued/index-j.shtml こんなふうに使います。 (use util.lcs) (define manuedify (make-manuedifier :open "【" :close "】")) (manuedify "試験監督間の間で教義があった" "試験監督官の間で協議があった") => "試験監督【間/官】の間で【教義/協議】があった" で、なんでわざわざ別に流すかというと、SKKのほうに入れるとGPLになってし まうからです(あとで回収するのが難しい)。 需要があればもうちょっといろいろ処理を書いて真鵺道モジュールに仕立てて もいいのですが、真鵺道をフル実装するのはけっこう大変そうです。 -- 木村 冬樹 (define (make-manuedifier . opts) (let-keywords* opts ((open "[") (close "]") (swap "|") (delete "/") (comment ";") (escape "~")) (let* ((cmds (list open close swap delete comment escape)) (rx-cmds (string->regexp (string-join (map regexp-quote cmds) "|"))) (rx-open (string->regexp (regexp-quote open)))) (define (escape-outer str) (regexp-replace-all rx-open str #`",|escape|\\0")) (define (escape-inner str) (regexp-replace-all rx-cmds str #`",|escape|\\0")) (define (manuedifier str1 str2) (with-output-to-string (lambda () (let1 out (open-output-string) (define (display-outer) (display (escape-outer (get-output-string out))) (close-output-port out) (set! out (open-output-string))) (define (display-inner) (display (escape-inner (get-output-string out))) (close-output-port out) (set! out (open-output-string))) (define (a-proc c type) (cond ((eq? type '=) (display-outer) (display open)) ((eq? type '+) (display-outer))) (write-char c out) '-) (define (b-proc c type) (cond ((eq? type '=) (display-outer) (display open) (display delete)) ((eq? type '-) (display-inner) (display delete))) (write-char c out) '+) (define (both-proc1 type) (cond ((eq? type '-) (display-inner) (display delete) (display close)) ((eq? type '+) (display-inner) (display close)))) (define (both-proc c type) (both-proc1 type) (write-char c out) '=) (let1 type (lcs-fold a-proc b-proc both-proc '= (string->list str1) (string->list str2)) (both-proc1 type) (display-outer)))))) manuedifier)))
