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

ユニコード正規化

common lisp

ユニコード正規化のcommon lispによる実装*1
common lisp処理系としては、SBCL等のユニコード(UTF-32)対応のものを想定

参照

実装に際して参考にさせてもらったサイト。
UAX #15: Unicode Normalization Forms
Unicode正規化


正規化に必要なデータ。
UnicodeData.txt: 各ユニコード文字の属性定義表
CompositionExclusions.txt: 正規合成時に除外する文字の一覧表

概要

ユニコード正規化の概要。
※ 自分用の(不正確な)メモでしかないので、ちゃんと知りたい人は他のサイトを参照のこと


ユニコードの正規化の形式は四種類。
NFD、NFC、NFKD、NFKC。
NFは、Normalization Form(正規化形式)の略。
Dは、Decomposition(分解)の略。
Cは、Composition(合成)の略。
Kは、Compatibility(互換性)の略。頭文字はCだが、Compositionと区別するためにKとなっている。
つまり、
・NFD: 分解 正規化形式
NFC: 合成 正規化形式
・NFKD: 互換分解 正規化形式
・NFKC: 互換合成 正規化形式


ユニコード正規化では、文字(or 文字列)のコード値は異なるが意味的には等価な文字群を変換し、一つの表現に統一する、といったようなことを行う(?)
ユニコードの等価性には正規等価性(Canonical Equivalence)と互換等価性(Compatibility Equivalence)の二種類があり、後者に従って変換すれば正規化形式にKの文字が付くようになる。

# 正規等価性  ※ 以下自分なりの理解で、仕様的には不正確
#   - 相互の文字(文字列)が意味的に全く等しい場合がこれに当たる
#     -- 互いを入れ替えても文の意味は全く変化しない
#   - 合成文字  と  基底文字+結合文字  間の対応が代表的?
#
# 以下、正規等価の例
[合成文字]       [基底文字+結合文字]
"ぱ"         <=> "ぱ"
# 互換等価性  ※ 以下自分なりの理解で、仕様的には不正確
#   - 文字(文字列)A、Bが正規等価なら、AとBは互換等価でもある
#   - 加えて、
#     -- AとBが意味的に完全には等しくなくても、相互に互換可能であるなら互換等価
#     -- 全角文字と半角文字の対応が例として挙げられる
#
# 以下、互換等価の例
[半角文字]     [全角文字]
"パ"       <=> "パ"

正規等価及び互換等価な文字(文字列)の対応表はUnicodeData.txtにて定義されているので、それに従って与えられた文字列を分解変換すれば、それぞれNFD(正規分解)、NFKD(互換分解)となる。
※ 実際には分解の後に、正規順序による結合文字の並び替えの処理がある
さらに、NFD及びNFKDによって分解した後の文字列を、正規等価性に従って合成変換すれば、それぞれNFC(正規合成)、NFKD(互換合成)となる。
※ ただし合成の際には CompositionExclusions.txt で定義されている文字を除外する必要がある。参照

[文字列]             [NFD]              [NFC] 
"ぱ"     =正規分解=> "ぱ" =正規合成=> "ぱ"

[文字列]             [NFKD]             [NFKC]
"パ"     =互換分解=> "パ" =正規合成=> "パ"

実装: データ読み込み

残りは実装コード。
UnicodeData.txt及びCompositionExclusions.txtはカレントディレクトリに保存済みと仮定する。

;; cl-ppcre: split関数を使う
(require :cl-ppcre)

;; 補助関数: 十六進数文字列を数値 or 文字に変換
(defun parse-hex      (s) (parse-integer s :radix 16))
(defun parse-hex-char (s) (code-char (parse-hex s)))

;; UnicodeData.txt読み込み
(defvar *unicode-data*
  (with-open-file (in "UnicodeData.txt")
    (loop FOR line = (read-line in nil nil) 
          WHILE line
      COLLECT (cl-ppcre:split ";" line))))

;; UnicodeData.txtに定義された文字属性を元に、以下の三つの表を作成する
;;  1] 正規分解変換表: 文字 => 分割後文字列
;;  2] 互換分解変換表: 文字 => 分割後文字列
;;  3] 正規結合クラス表: 文字 => 正規結合クラス(数値). 結合文字を正規順序にソートする際に用いる
(let ((canonical-decomp-map (make-hash-table))
      (compatible-decomp-map (make-hash-table))
      (canonical-combinig-class (make-hash-table)))
  ;; 各文字定義を走査
  ;;  - 1st: 文字のコード値
  ;;  - 4th: 正規結合クラス(Canonical Combining Class)
  ;;  - 6th: 分解後のコード列. 互換分解の場合は先頭に"<...>"形式で、互換性の種類が記述されている
  (loop FOR (1st _ __ 4th ___ 6th) IN *unicode-data*
        FOR char = (parse-hex-char 1st)
        FOR ccc  = (parse-integer 4th)
        FOR decomp-chars =
        (let ((tmp (cl-ppcre:split " " 6th)))
          (when tmp
            (if (char= #\< (char (first tmp) 0))
                (cons :compatible (mapcar #'parse-hex-char (cdr tmp))) ; 互換分解
              (cons :canonical (mapcar #'parse-hex-char tmp)))))       ; 正規分解
    DO
    ;; 正規結合クラス
    (when (plusp ccc)
      (setf (gethash char canonical-combinig-class) ccc))

    ;; 分解表
    (when decomp-chars
      (if (eq (car decomp-chars) :canonical)
          (setf (gethash char canonical-decomp-map) (cdr decomp-chars))   ; 正規分解
        (setf (gethash char compatible-decomp-map) (cdr decomp-chars))))) ; 互換分解

  (defvar *canonical-decomp-map* canonical-decomp-map)
  (defvar *compatible-decomp-map* compatible-decomp-map)
  (defvar *canonical-combinig-class* canonical-combinig-class))

;; 補助関数2: 文字の正規結合クラスを取得する
(defun get-canonical-combinig-class (ch)
  (gethash ch *canonical-combinig-class* 0))

;; 合成除外表の読み込み
(let ((comp-exclusion-set (make-hash-table)))
  (with-open-file (in "CompositionExclusions.txt")
    (loop FOR line = (read-line in nil nil)
          WHILE line
          WHEN (and (plusp (length line))
                    (char/= (char line 0) #\#))
      DO
      (setf (gethash
             (code-char
              (parse-integer line :end (position #\Space line) :radix 16))
             comp-exclusion-set)
            t)))
  (defparameter *comp-exclusion-set* comp-exclusion-set))

;; 正規合成変換表の作成
;;  - 基本的には、正規分解変換表を逆にするだけだが、合成除外表に含まれる文字は対象外とする必要がある
(let ((canonical-comp-map (make-hash-table :test #'equal)))
  (maphash 
   (lambda (src-char decomped-chars)
     (when (and (= 2 (length decomped-chars))
                (not (gethash src-char *comp-exclusion-set*)))
       (setf (gethash (coerce decomped-chars 'list)
                      canonical-comp-map)
             src-char)))
   *canonical-decomp-map*)
  (defparameter *canonical-comp-map* canonical-comp-map))

#|
分解(NFD,NFKD)に必要な変数:
- *canonical-decomp-map*
- *compatible-decomp-map*
- *canonical-combinig-class*

合成(NFC,NFKC)に必要な変数:
- *canonical-comp-map*
|#

分解

NFD及びNFKD。
まずは分解部。
※ 下のコードではハングル文字に対する処理が抜けているため不完全。詳しくは後述。

;; 文字を分解する. typeは、:canonical or :compatible
(defun decompose-char (char type)
  (let ((decomped-chars (or (gethash char *canonical-decomp-map*)
                            (and (eq type :compatible)  ; 互換分解も含める?
                                 (gethash char *compatible-decomp-map*)))))
    (if decomped-chars
        ;; 分解後の文字列が、分解対象文字を含んでいることがあるので、再帰的に繰り返す
        (mapcan (lambda (c) (decompose-char c type)) decomped-chars)
      (list char))))

;; 文字列を分解する. typeは、:canonical or :compatible
(defun decompose (s type)
  (loop FOR c ACROSS s
    APPEND
      (decompose-char c type)
      INTO new-s
    FINALLY
      (return (coerce new-s 'string))))

;; 分解後の文字列に含まれる結合文字を、正規結合クラスに従ってソートする
(defun canonical-ordering (decomposed-string &aux (s decomposed-string))
  ;; 開始文字(= 正規結合クラスが0)の位置リストを取得する
  (let ((starter-indices
         (loop FOR i FROM 1 BELOW (length s)
               FOR ccc = (get-canonical-combinig-class (aref s i))
               WHEN (zerop ccc)
           COLLECT i)))
    (loop FOR (beg end) ON (cons 0 starter-indices) DO
      ;; 結合文字をソートする
      (setf #1=(subseq s beg end) 
            (stable-sort #1# #'< :key #'get-canonical-combinig-class))))
  s)

;; NFD
(defun nfd (str)
  (canonical-ordering (decompose str :canonical)))

;; NFKD
(defun nfkd (str)
  (canonical-ordering (decompose str :compatible)))
(nfd "ぱ")
    • > "ぱ"
(nfd "パ")
    • > "パ"
(nfkd "パ")
    • > "パ"

合成

NFC及びNFKC。
※ 下のコードではハングル文字に対する処理が抜けているため不完全。詳しくは後述。

;; 文字列を合成する
;; ペアとなる文字を探して合成文字を作成する、ということを繰り返す
(defun compose (decomposed-string)
  (let* ((s decomposed-string) 
         (to-cs (coerce s 'simple-vector)))
    (loop FOR i FROM 1 BELOW (length s)
          FOR ch-right  = (char s i)      ; 右側の文字
          FOR ccc-right = (get-canonical-combinig-class ch-right)
      DO
      (loop FOR j FROM (1- i) DOWNTO 0
            FOR ch-left  = (aref to-cs j) ; 左側の文字
            FOR ccc-left = (and ch-left (get-canonical-combinig-class ch-left))
            WHEN ch-left
        DO
        (when (zerop ccc-left)
          ;; ch-left + ch-right の合成文字が存在するなら、それでch-leftを置換する
          (let ((comped-char (gethash (list ch-left ch-right) *canonical-comp-map*)))
            (when comped-char
              (setf (aref to-cs j) comped-char
                    (aref to-cs i) nil)))
          (return))
       
        (unless (< ccc-left ccc-right)
          (return))))
    (coerce (remove nil to-cs) 'string)))

;; NFC
(defun nfc (s)
  (compose (nfd s)))

;; NFKC
(defun nfkc (s)
  (compose (nfkd s)))
(nfc "ぱ")
    • > "ぱ" ; "ぱ" => "ぱ" => "ぱ"
(nfc "パ")
    • > "パ" ; "パ" => "パ" => "パ"
(nfkc "パ")
    • > "パ" ; "パ" => "パ" => "パ"

ハングル文字

これまで載せてきたコードは、ハングル文字に対する対する処理が抜けているので、実は正しくない。
ハングル文字に関しては、分解/合成変換をアルゴリズム的に行うことが可能ということで(?)、UnicodeData.txtには対応表が記載されていない。
その分解/合成変換アルゴリズム(の実装コード)UAX #15: Unicode Normalization Forms に記載されており、それをcommon lisp用に翻訳したのが以下のコードとなる。

;; ハングル文字用の分割/合成変換関数
;; 詳細は右のリンク先を参照のこと: http://www.unicode.org/reports/tr15/#Hangul
(let* ((s-base #xAC00)
       (l-base #x1100)
       (v-base #x1161)
       (t-base #x11A7)
       (l-count 19)
       (v-count 21)
       (t-count 28)
       (n-count (* v-count t-count))
       (s-count (* l-count n-count)))
  ;; 分割
  (defun decompose-hangul-char (ch &aux (cd (char-code ch)))
    (let ((s-index (- cd s-base)))
      (unless (<= 0 s-index (1- s-count))
        (return-from decompose-hangul-char (list ch)))
      
      (let ((lc (+ l-base (floor s-index n-count)))
            (vc (+ v-base (floor (mod s-index n-count) t-count)))
            (tc (+ t-base (mod s-index t-count))))
        (if (/= tc t-base)
            (list (code-char lc) (code-char vc) (code-char tc))
          (list (code-char lc) (code-char vc))))))
  
  ;; 合成
  (defun compose-hangul (str &aux (len (length str)))
    (if (zerop len)
        str
      (let* ((last (char str 0))
             (new-chars (list last)))
        (loop FOR i FROM 1 BELOW len
              FOR ch = (char str i)
              FOR l-index = (- (char-code last) l-base)
              FOR s-index = (- (char-code last) s-base)
          DO
          (tagbody
           ;; 1. check to see if two current characters are L and V
           (when (<= 0 l-index (1- l-count))
             (let ((v-index (- (char-code ch) v-base)))
               (when (<= 0 v-index (1- v-count))
                 ;; make syllable of form LV
                 (setf last 
                       (code-char (+ s-base (* (+ (* l-index v-count) v-index) t-count))))
		 (setf (car new-chars) last) ; reset last
                 (go :end))))                ; discard ch
           
           ;; 2. check to see if two current characters are LV and T
           (when (and (<= 0 s-index (1- s-count))
                      (zerop (mod s-index t-count)))
             (let ((t-index (- (char-code ch) t-base)))
               (when (< 0 t-index t-count)
                 ;; make syllable of form LVT
                 (setf last (code-char (+ (char-code last) t-index)))
                 (setf (car new-chars) last) ; reset last
                 (go :end))))                ; discard ch

           ;; if neigher case was true, just add the character
           (push (setf last ch) new-chars)
           :end))
        (coerce (nreverse new-chars) 'string)))))

ハングル文字に対応した各種正規化形式用の関数定義は次のようになる。

;; NFD
(defun nfd (str)
  (canonical-ordering 
   (coerce
    (reduce #'append (decompose str :canonical) :key #'decompose-hangul-char)
    'string)))

;; NFKD
(defun nfkd (str)
  (canonical-ordering 
   (coerce
    (reduce #'append (decompose str :compatible) :key #'decompose-hangul-char)
    'string)))

;; NFC
(defun nfc (s)
  (compose-hangul (compose (nfd s))))

;; NFKC
(defun nfkc (s)
  (compose-hangul (compose (nfkd s))))

一応これで四種類のユニコード正規化形式の実装は終了。

テスト

最後は、正規化が問題なく行えているかどうかのテスト。
テストデータにはNormalizationTest.txtを用いる。
テスト方法等については、上記ファイルの冒頭にて説明されているので、そちらを参照してもらうこととし、以下テスト用のコードのみを掲載。

;; テストデータ読み込み
(defparameter *test-data*
  (with-open-file (in "NormalizationTest.txt")
    (loop FOR line = (read-line in nil nil)
          WHILE line
          UNLESS (find (char line 0) "#@")
      COLLECT
      ;; 正規化対象となる各文字列が';'区切りで並んでいる
      (destructuring-bind (a b c d e &rest _) (cl-ppcre:split ";" line)
        (declare (ignore _))
        (flet ((to-string (space-delimited-char-codes)
                 (map 'string #'parse-hex-char (cl-ppcre:split " " space-delimited-char-codes))))
          (list (to-string a)
                (to-string b)
                (to-string c)
                (to-string d)
                (to-string e)))))))

;; テスト用関数定義マクロ
(defmacro def-nf-test (fn-name dest-1st dest-2nd dest-3rd dest-4th dest-5th)
  `(defun ,fn-name (fn data)
     (loop FOR (1st 2nd 3rd 4th 5th) IN data
           FOR i FROM 0
           FOR result = (list (string= ,dest-1st (funcall fn 1st))
                              (string= ,dest-2nd (funcall fn 2nd))
                              (string= ,dest-3rd (funcall fn 3rd))
                              (string= ,dest-4th (funcall fn 4th))
                              (string= ,dest-5th (funcall fn 5th)))
       WHEN (some #'null result)
       DO
       ;; 不正な正規化が行われた場合
       (return-from ,fn-name
                    (values nil `(,i ,(nth i data) ,result))))
     t))

;; テスト用関数定義
;; NFD
(def-nf-test test-nfd  3rd  ; 3rd = NFD(1st) 
                       3rd  ; 3rd = NFD(2nd)
                       3rd  ; 3rd = NFD(3rd)
                       5th  ; 5th = NFD(4th)
                       5th) ; 5th = NFD(5th)
;; NFKD
(def-nf-test test-nfkd 5th  ; 5th = NFKD(1st)
                       5th  ; 5th = NFKD(2nd)
                       5th  ; 5th = NFKD(3rd)
                       5th  ; 5th = NFKD(4th)
                       5th) ; 5th = NFKD(5th)
;; NFC
(def-nf-test test-nfc  2nd  ; 2nd = NFC(1st) 
                       2nd  ; 2nd = NFC(2nd)
                       2nd  ; 2nd = NFC(3rd)
                       4th  ; 4th = NFC(4th)
                       4th) ; 4th = NFC(5th)
;; NFKC
(def-nf-test test-nfkc 4th  ; 4th = NFKC(1st)
                       4th  ; 4th = NFKC(2nd)
                       4th  ; 4th = NFKC(3rd)
                       4th  ; 4th = NFKC(4th)
                       4th) ; 4th = NFKC(5th)

テスト。

;; NFD
(test-nfd #'nfd *test-data*)
--> T

;; NFKD
(test-nfkd #'nfkd *test-data*)
--> T

;; NFC
(test-nfc #'nfc *test-data*)
--> T

;; NFKC
(test-nfkc #'nfkc *test-data*)
--> T

大丈夫そう。

*1:今回は実装方法の確認(のみ)を目的としているのでいろいろいろ非効率