uimで草を生やす・続き

この変換規則は以下のコードで生成したもの。これをgen.scmなどと名付けて、uim-sh $(pwd)/gen.scm | fold -sのように実行する。

このコードの最後のprintの呼び出しを削除すればそのまま.uimとしても使えるが、アプリ起動のたびに走るコードとしては重すぎるのでお奨めしない。

ja-rk-ruleに別のカスタマイズを加える場合は、こちらのコードに追加すればいい。

(require "japanese.scm")
(require "lib/srfi-95.scm")

; (rev-tails '(1 2 3)) => (() (3) (2 3) (1 2 3))
(define (rev-tails lst)
  (let loop ((acc '()) (lst lst))
    (if (null? lst)
      (cons '() acc)
      (loop (cons lst acc) (cdr lst)))))

; (inits '(1 2 3)) => (() (1) (1 2) (1 2 3))
(define (inits lst)
  (map reverse (rev-tails (reverse lst))))

(define (prefix? lst pfx)
  (or (null? pfx)
      (and (pair? lst)
           (equal? (car lst) (car pfx))
           (prefix? (cdr lst) (cdr pfx)))))

(define (suffix? lst sfx)
  (prefix? (reverse lst) (reverse sfx)))

(define (init lst)
  (take lst
    (- (length lst) 1)))

(define rule-head caar)

(define (intermediate-strings rule)
  (let ((partials (inits (rule-head rule))))
    (cdr (init partials))))

(define (fullwidth str)
  (let ((w-str (ja-wide str)))
    (list w-str w-str str)))

(define (make-rule head push out)
  (list (cons head push) out))

(define (make-fullwidth-rule strs)
  (make-rule strs '() (map fullwidth strs)))

(define (fullwidth-transitions strs)
  (let ((sstrs (sort strs (lambda (x y) (> (length x) (length y))))))
    (concatenate
      (map
        (lambda (str)
          (let ((str-len (length str)))
            (let loop ((acc '()) (used '()) (nexts sstrs))
              (if (null? nexts) acc
                (let* ((next (car nexts))
                       (next-len (length next))
                       (ch (last next)))
                  (if 
                    (and
                      (<= next-len str-len)
                      (< 1 next-len)
                      (not (find (lambda (x) (equal? x ch)) used))
                      (suffix? str (init next)))
                    (loop
                      (cons
                        (let*
                          ((str+ (append str (list ch)))
                           (len (+ 1 (- str-len next-len))))
                          (make-rule
                            str+
                            (drop str+ len)
                            (map fullwidth (take str+ len))))
                        acc)
                      (cons ch used)
                      (cdr nexts))
                    (loop acc used (cdr nexts))))))))
        sstrs))))

; augment 'rules' with rules that convert any unresolved consonant sequences into their fullwidth form.
; example: "k" -> "ｋ", "ky" -> "ｋｙ", "kyy" -> "ｋ"|"yy"
(define (add-fullwidth-rules rules)
  (let ((strs
        (delete-duplicates
          (concatenate
            (map intermediate-strings
              rules)))))
    (append 
      rules
      (map make-fullwidth-rule strs)
      (fullwidth-transitions strs))))

(define small-tsu
  '("っ" "ッ" "ｯ"))

(define (smalltsu-rule? rule)
  (and
    (pair? (cdar rule))
    (equal? (second rule) (list small-tsu))))

; (make-dupl '((("k" "o") . ()) (("こ" "コ" "ｺ"))))
; => ((("k" "k" "o") . ()) (("っ" "ッ" "ｯ") ("こ" "コ" "ｺ")))
(define (make-dupl rule)
  (make-rule
    (cons
      (first (rule-head rule))
      (rule-head rule))
    '()
    (cons
      small-tsu
      (second rule))))

(define (make-nonpush push nonpush)
  (concatenate
    (map
      (lambda (rule)
        (map make-dupl
          (filter 
            (lambda (nrule)
              (equal? 
                (first (rule-head nrule))
                (first (cdr (first rule)))))
            nonpush)))
      push)))

; replace rules like
;   "kk" -> "っ"|"k"
; with
;   "kka" -> "っか"
;   "kki" -> "っき"
; and so on
(define (replace-smalltsu-rules rules)
  (receive (push-rules nonpush) (partition smalltsu-rule? rules)
    (append
      nonpush
      (make-nonpush push-rules nonpush))))

(define (normalize rule)
  (if
    (pair?
      (first (second rule)))
    rule
    (list
      (first rule)
      (list (second rule)))))

(define (denormalize rule)
  (if
    (eqv? 1 (length (second rule)))
    (list
      (first rule)
      (first (second rule)))
    rule))

(set! ja-rk-rule 
  (map denormalize
    (add-fullwidth-rules
      (replace-smalltsu-rules
        (map normalize ja-rk-rule)))))

(print ja-rk-rule) ; comment out this line if you are putting this code in .uim

中身

何をやっているかを簡単に書く。

まず、ローマ字として入力されたがまだひらがなになっていない文字列を、ローマ字バッファにあると言うことにして、[]で囲んで表記する。[ny]のように。また、出力されるひらがなは""で囲む。"にゃ"のように。

この表記を使うと、uimデフォルトの変換規則は次のように書ける。

[a] -> "あ"
[i] -> "い"
...
[ka] -> "か"
[ki] -> "き"
...
[kk] -> "っ"[k]
[tt] -> "っ"[t]
...
[n] -> "ん"
[na] -> "な"
...

キー入力があったときの変換アルゴリズムは次のようになっている(読んでいないので推測)。

• ローマ字バッファに前方一致するが完全一致しない変換規則があれば、なにもしないで終了。
• ローマ字バッファに完全一致する変換規則があれば、適用して終了。
• ローマ字バッファから最新のストロークを除いたものに完全一致する変換規則があれば、適用して終了。
• 以上のいずれでもなければ、ローマ字バッファから最新のストローク以外を削除して終了。

第一の変更は、子音連続で"っ"を出力する規則を全て削除して、代わりに"っ"から始まる規則を追加するもの。

[kk] -> "っ"[k]
を削除し、
[kka] -> "っか"
[kki] -> "っき"
...
に

第二の変更は、ローマ字バッファの内容をそのまま全角アルファベットに変換する規則の追加。

[k] -> "ｋ"
[ky] -> "ｋｙ"
...

第三の変更は、上記のアルゴリズムでローマ字バッファからの削除が起こるケースを網羅して、削除せずに全角アルファベットとして出力する規則の追加。

[kyy] -> "ｋ"[yy]
[sshw] -> "ｓｓ"[hw]
...

uim-skkユーザは

くぁｗせｄｒｆｔｇｙふじこｌｐが必要なら辞書登録するしかなさそう。