マルチバイト文字列→ユニコード文字列

DoubleArray(トライの一種)を利用して、マルチバイト文字列をユニコード文字列にある程度自動的に変換する、という試み(?)。
ちゃんとした形に整理するほどの気力はないので、一応動く程度のソースコードと覚え書きを残しておくことにする。

やること＆概要

マルチバイト文字列からユニコード文字列への変換を(エンコード形式に依存せずに)自動的に行えるようにする。

そのための手順(の概要)は以下の通り。

1. ユニコード文字と(特定のエンコード形式の)バイト列の対応を何らかの方法で所得する。
   • 今回は、SBCLのsb-ext:string-to-octets関数を使って、両者の対応を取得することにする。
2. 1で取得した対応表を使い、バイト列をキーに、ユニコード値を値として、トライ(DoubleArray)を構築する。
3. ※ ここまでで変換のための準備は終了。
4. バイト列からユニコード列への変換には、以下の処理を行う。
   1. 2で作成したトライを使い、変換元のバイト列に対してcommon-prefix検索を行う。
   2. 一致する値(=ユニコード)が見つかった場合、その値と入力バイト列上での一致位置を返す。
   3. 上の一致位置を次の始点として、同様の処理を繰り返す。
   4. 一致位置==バイト列の長さ、となったら処理を終了する。
   5. 処理終了時に集まっているユニコード列が、変換後の文字列となる。

要は「バイト列=>ユニコード」のマッピングを保持したトライに対して、ひたすらcommon-prefix検索を適用しているだけ。
これだと、ユニコードとバイト列の対応さえ何らかの方法で取得すれば、後は特に難しいことを考える必要もなく、変換を自動的に行える(はず)。

メモ付きのソースコード

以降はそのためのソースコード。
DoubleArrayの実装も含まれているため、結構長い。

バイト列とユニコードの対応表

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; バイト列とユニコードの対応表の作成
;;;;   今回はそのためにsbclのsb-ext:string-to-octets関数を利用する
;;;;
;;;; SBCL-1.0.37: 以下同

;; ユニコード<=>バイト列
(defstruct map.entry
  (unicode 0 :type fixnum)
  (octets  0 :type list))

;; バイト列とユニコードの対応表(リスト)を作成する
;;  - external-format: バイト列のエンコード方式
(defun gen-octets=>unicode-map-impl (external-format)
  (loop FOR cd FROM 0 BELOW char-code-limit
    FOR ch = (code-char cd)
    FOR octets = (ignore-errors  ;; 全てのユニコード文字を、バイト列に変換してみる
                  (sb-ext:string-to-octets
                   (string ch) 
                   :external-format external-format))
    WHEN octets  ;; 対応するバイト列があるもののみを集める
    COLLECT (make-map.entry :unicode cd :octets (coerce octets 'list))))

;; ソート済みのリストのユニーク処理を行う  ※ map.entry専用
(defun unique-sorted-list (list)
  (flet ((eql? (a b) (equal (map.entry-octets a) (map.entry-octets b))))
    (when list
      (cons (car list)
        (loop FOR prev IN list
              FOR cur  IN (cdr list)
          UNLESS (eql? prev cur)
          COLLECT cur)))))

;; ソート用の比較関数
(defun map.entry-octets< (a b)
  (loop FOR o1 fixnum IN (map.entry-octets a)
        FOR o2 fixnum IN (map.entry-octets b) DO
    (cond ((null o2) (return nil))
          ((null o1) (return t))
          ((< o1 o2) (return t))
          ((> o1 o2) (return nil)))))

;; バイト列とユニコードの対応表(リスト)を作成する
;;  - リストはバイト列の昇順にソートする
;;  - 対応するユニコード値が複数あるバイト列は、変換時の曖昧性を除去するため、その内のどれか一つを選択する
;;    ※ 現状は複数候補の内でどれが使われるかはランダム
(defun gen-octets=>unicode-map (external-format)
  (unique-sorted-list
   (sort (gen-octets=>unicode-map-impl external-format)
         #'map.entry-octets<)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EUC-JP用の対応表を作成しておく
(defvar *eucjp-octets=>unicode* 
  (gen-octets=>unicode-map :euc-jp))

*eucjp-octets=>uniocde*
--> (#S(MAP.ENTRY :UNICODE 0 :OCTETS (0)) 
     #S(MAP.ENTRY :UNICODE 1 :OCTETS (1))
     #S(MAP.ENTRY :UNICODE 2 :OCTETS (2)) 
     #S(MAP.ENTRY :UNICODE 3 :OCTETS (3))
     #S(MAP.ENTRY :UNICODE 4 :OCTETS (4)) 
     #S(MAP.ENTRY :UNICODE 5 :OCTETS (5))
     ;; 中略
     #S(MAP.ENTRY :UNICODE 27079 :OCTETS (244 162))
     #S(MAP.ENTRY :UNICODE 36953 :OCTETS (244 163))
     #S(MAP.ENTRY :UNICODE 29796 :OCTETS (244 164))
     #S(MAP.ENTRY :UNICODE 20956 :OCTETS (244 165))
     #S(MAP.ENTRY :UNICODE 29081 :OCTETS (244 166)))

DoubleArray構築

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; DoubleArray構築用ソースコード
;;;;  ※ 未整理。多分まだバグがある。

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 利用可能なノード(BASE/CHECK配列のインデックス)を管理するアロケータ
(defstruct (allocator (:conc-name al-))
  (link (make-array #x1)                       :type simple-vector)      ; 空きノードを管理するためのリンクリスト的な配列
  (bset (make-array #x1000 :element-type 'bit) :type simple-bit-vector)) ; BASE配列の値の重複を避けるためのbit配列

(defstruct (link-node (:conc-name ln-))
  (next 0 :type fixnum)   ; 次の空きノードのインデックス
  (prev 0 :type fixnum))  ; 前の空きノードのインデックス
  
;; allocator-linkのサイズを増やす
(defun resize-link (alloca new-size)
  (with-slots (link) alloca
    (let ((size (length link)))
      (setf link (adjust-array link new-size))

      ;; 増加分のリンクを調整
      (loop FOR i FROM size BELOW new-size DO
        (setf (aref link i) (make-link-node :prev (1- i) :next (1+ i)))))))

;; アロケータを初期化
(defun init-allocator ()
  (let ((alloca (make-allocator)))
    (setf (aref (al-link alloca) 0) (make-link-node :prev 0 :next 1))
    (resize-link alloca #x1000)
    alloca))

;; 補助マクロ
;; ary[index]に確実にアクセスできるようにする
;; 配列のサイズがindexよりも小さい場合は、配列を拡張する
;; 拡張分の要素は、defaultの値で埋められる
(defmacro assuref (ary index &key (default 0))
  (let ((size (gensym)))
    `(let ((,size ,index))
       (if (< ,size (length ,ary))
           ,ary
         (setf ,ary (adjust-array ,ary (* ,size 2) :initial-element ,default))))))

;; 遷移に用いるバイト値のリストを受け取り、利用可能なBASEの値を返す
;;  (every (lambda (byte) (空きノード? (+ BASE値 byte))) codes) => true
;;
;;  alloca: allocator
;;  codes: (list バイト値 ...)
(defun x-check (alloca codes)
  (with-slots (link bset) (the allocator alloca)
    (loop FOR cur = (ln-next (aref link 0)) THEN (ln-next (aref link cur))
          FOR x = (- cur (first codes)) 
      UNLESS (minusp x)
      DO
        (assuref bset x)
        (when (and (zerop (bit bset x))
                   (can-allocate? link codes x))
          (setf (bit bset x) 1)         ; このBASEの値はもう使えない
          (dolist (code codes)
            (alloc alloca (+ x code)))  ; 空きノード => 使用中ノードに変更
          (return x)))))

;; 割り当て可能か?
(defun can-allocate? (link codes x-node)
  (every (lambda (code &aux (node (+ code x-node)))
           (or (>= node (length link))                     ; - ノードインデックスがlinkのサイズを越えている場合は、そのノードは使用可能(link.size以上の領域は、全て未使用なことが確実)
               (not (zerop (ln-next (aref link node))))))  ; - link[x-node+code].next != 0 なら、そのノードは使用可能
         (cdr codes)))

;; 空きノードを使用中に変更する
(defun alloc (alloca node)
  (with-slots (link) (the allocator alloca)
    (when (>= node (1- (length link)))
      (resize-link alloca (* node 2)))

    ;; リンクノードの張替え:  link.next==0は、使用中の印
    (let ((cur (aref link node)))
      (setf (ln-next (aref link (ln-prev cur))) (ln-next cur)
            (ln-prev (aref link (ln-next cur))) (ln-prev cur)
            (ln-next cur) 0))))


;;;;;;;;;;;;;;;;;;;
;;; DoubleArray構築

;; DoubleArrayトライ: BASE配列とCHECK配列
(defstruct trie
  (base #() :type (vector (signed-byte 32)))
  (chck #() :type (vector (unsigned-byte 16))))

;; バイト列とユニコードの対応表を元に、DoubleArrayを構築する
;;
;;  - alloca: allocator構造体
;;  - code-map: バイト列とユニコードの対応表(リスト)
;;  - trie: trie構造体
;;  - beg: 現在処理中のcode-map要素の開始位置
;;  - end: 現在処理中のcode-map要素の終端位置
;;  - root-idx: 現在処理中のトライの親ノード
(defun build (alloca code-map trie beg end root-idx)
  (declare (trie trie))
  (if (= (- end beg) 1)
      ;; root-idxから派生するノードが一つだけになった場合
      ;; 対応するユニコード値をセットする
      (set-unicode alloca trie root-idx (aref code-map beg))
    ;; それ以外の場合
    (with-slots (base chck) trie
      (let ((codes '())
            (ends '()))
        ;; root-idxから派生するノードを集める
        (loop WITH prev = #xFFFF
              FOR i FROM beg BELOW end 
              FOR cur = (read-next-octet (aref code-map i)) 
          WHEN (/= prev cur)
          DO
            (setf prev cur)
            (push cur codes)
            (push i ends))
        (push end ends)

        (loop WITH x = (x-check alloca (reverse codes))         ; 利用可能なBASEを計算
              FOR (child-beg child-end) ON (nreverse ends)      
              FOR arc-code              IN (nreverse codes) DO
              ; 子ノードをセットして、再帰的に処理を繰り返す
              (build alloca code-map trie child-beg child-end 
                          (set-node trie root-idx arc-code x))))))) 

;; BASE配列に格納するためにユニコード値をエンコードする
(defun encode-unicode (unicode)
  (- (1+ unicode)))

;; BASEおよびCHECK配列のノードを設定する
(defun set-node (trie prev-node arc-code x-node)
  (declare (trie trie))
  (with-slots (base chck) trie
    (let ((next-node (+ x-node arc-code)))
      ;; 範囲外アクセス防止
      (assuref base prev-node :default 0)
      (assuref chck next-node :default #xFFFF)
      
      ;; BASE/CHECK設定
      (setf (aref base prev-node) x-node   
            (aref chck next-node) arc-code) 
      next-node)))

;; ユニコードを設定する
(defun set-unicode (alloca trie root-idx entry)
  (declare (trie trie))
  (with-slots (base chck) trie
    ;; まだ未設定のノード(バイト値)を設定する
    (loop WITH unicode = (map.entry-unicode entry)
          FOR arc-code IN (map.entry-octets entry)
          FOR x-node = (x-check alloca `(,arc-code)) 
    DO
      (setf root-idx (set-node trie root-idx arc-code x-node))
    FINALLY
      ;; ユニコードをBASEに格納する
      (assuref base root-idx :default 0)
      (setf (aref base root-idx) (encode-unicode unicode)))))))

;; DoubleArrayの構築とディスクへの保存
(defun build-and-save (code-map trie-path)
  (let ((trie (make-trie 
               :base (make-array #x1000 :element-type '(signed-byte 32) :initial-element 0)
               :chck (make-array #x1000 :element-type '(unsigned-byte 16) :initial-element #xFFFF))))
    ;; トライ作成
    (build (init-allocator) (coerce code-map 'vector) trie 0 (length code-map) 0)
    
    (with-slots (base chck) trie
            ;; サイズの調整
      (let ((adjusted-size (+ #x100 (loop FOR a ACROSS base MAXIMIZE a))))
        ;; BASE保存
        (with-open-file (out trie-path :direction :output 
                                       :if-exists :supersede
                                       :element-type '(signed-byte 32))
          (loop FOR e ACROSS (adjust-array base adjusted-size)
            DO (write-byte e out)))
        ;; 追加でCHECK保存
        (with-open-file (out trie-path :direction :output 
                                       :if-exists :append
                                       :element-type '(unsigned-byte 16))
          (loop FOR e ACROSS (adjust-array chck adjusted-size)
            DO (write-byte e out))))))
  'done)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; EUC-JP用のトライの作成と保存
(build-and-save *eucjp-octets=>unicode* "eucjp.trie")
--> DONE

DoubleArray検索とバイト列→ユニコード文字列変換

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; DoubleArrayの検索と、それを用いたバイト列からユニコード文字列への変換用ソースコード

;;;;;;;;;;;;;;;;;;;
;;; DoubleArray検索
(declaim (inline next-index octets-to-unicode decode-unicode))

;;; 以下二つは、上で保存したDoubleArrayのロード用関数
;; ファイルpathから、count分だけtype型の要素を読み込む
(defun read-bytes (path type count &optional (offset 0))
  (with-open-file (in path :element-type type)
    (let ((buf (make-array count :element-type type)))
      (file-position in offset)
      (read-sequence buf in)
      buf)))

;; トライをロードする
(defun load-trie (path)
  (let ((size (with-open-file (in path) (/ (file-length in) 6))))
    (make-trie
     :base (read-bytes path '(signed-byte 32) size)
     :chck (read-bytes path '(unsigned-byte 16) size (* size 2)))))

;;; 検索用関数群
;; BASEに格納されているユニコード値を復元し、そのcharacter表現を返す
(defun decode-unicode (node)
  (code-char (1- (- node))))

(defun next-index (node code)
  (+ node code))

;; バイト列をstartから走査して、一番初めに見つかったユニコード文字を返す
;;  => (values ユニコード文字 バイト列内の走査済み位置+1) 
(defun octets-to-unicode (octets start trie)
  (declare (optimize (speed 3) (debug 0) (safety 0))
           ((simple-array (unsigned-byte 8)) octets)
           (fixnum start)
           (trie trie))
   
  ;; DoubleArrayのcommon-prefix検索
  (symbol-macrolet ((base (trie-base trie))
                    (chck (trie-chck trie)))
    (let ((node (aref base 0)))
      (declare (fixnum node))
      (loop FOR i fixnum FROM start BELOW (length octets) 
            FOR code OF-TYPE octet = (aref octets i) 
            FOR idx OF-TYPE fixnum = (next-index node code) DO
        (setf node (aref base idx))
        
        (unless (= (aref chck idx) code)
          (return-from octets-to-unicode (values nil (1+ start)))) ; 検索に失敗した場合はnilを返す

        (when (minusp node)
          (return-from octets-to-unicode (values (decode-unicode node) (1+ i))))))) ; 一致を検出
  (values nil (1+ start))) ; 検索に失敗した場合はnilを返す

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; バイト列→ユニコード文字列変換
(defun my-octets-to-string (octets trie)
  (declare (optimize (speed 3) (debug 0) (safety 0))
           (simple-octets octets))
  (let* ((len (length octets))
         (buf (make-array len :element-type 'character)) ; 変換後の文字列用に多めにバッファを確保しておく
         (tail-pos -1)
         (i 0)
         (char nil))
    (declare (fixnum tail-pos i))
    ;; バイト列の終端に達するまで、octets-to-unicode関数を呼び出す
    (loop (setf (values char i) (octets-to-unicode octets i trie))
      (assert char () "変換不能なバイト列を検出しました。(位置: ~D)" i)

      (setf (aref buf (incf tail-pos)) char)
      (when (>= i len)
        (return)))
    (subseq buf 0 (1+ tail-pos))))

これで完成。

使用例と計時

まず準備。
参照: read-file

;; バイト列の準備
;; 夏目漱石の『こころ』の三種類のエンコード方式によるバイト列を作成
(defvar *kokoro* (read-file "/path/to/kokoro"))
(defvar *kokoro.euc-jp* (sb-ext:string-to-octets *kokoro* :external-format :euc-jp))     ; EUC-JP
(defvar *kokoro.utf8*   (sb-ext:string-to-octets *kokoro* :external-format :utf8))       ; UTF-8
(defvar *kokoro.utf16le*   (sb-ext:string-to-octets *kokoro* :external-format :utf16le)) ; UTF-16-LittleEndian

;; 変換用トライの準備
(progn  ; EUC-JP
  (build-and-save (gen-octets=>unicode-map :euc-jp) "eucjp.trie")
  (defvar *eucjp-trie* (load-trie "eucjp.trie")))
(progn  ; UTF-8
  (build-and-save (gen-octets=>unicode-map :utf8) "utf8.trie")
  (defvar *utf8-trie* (load-trie "utf8.trie")))
(progn  ; UTF-16-LittleEndian
  (build-and-save (gen-octets=>unicode-map :utf16le) "utf16le.trie")
  (defvar *utf16le-trie* (load-trie "utf16le.trie")))

;; 計時方法  ※ euc-jp, my-octets-to-stringの場合
(time 
  (dotimes (i 10 'done)
    (my-octets-to-string *kokoro.euc-jp* *eucjp-trie*)))

;; 変換に成功しているかチェック
(and
 (string=
  (sb-ext:octets-to-string *kokoro.euc-jp* :external-format :euc-jp)
  (my-octets-to-string *kokoro.euc-jp* *eucjp-trie*))
 
 (string=
  (sb-ext:octets-to-string *kokoro.utf8* :external-format :utf8)
  (my-octets-to-string *kokoro.utf8* *utf8-trie*))

 (string=
  (sb-ext:octets-to-string *kokoro.utf16le* :external-format :utf16le)
  (my-octets-to-string *kokoro.utf16le* *utf16le-trie*)))
==> T

結果。

エンコーディング	sb-ext:*での処理時間	my-*での処理時間	トライのファイルサイズ
EUC-JP	0.092s	0.478s	79KB
UTF-8	0.125s	0.151s	6.5MB
UTF-16LE	0.104s	0.216s	7.9MB

sbclのバイト列デコード関数は結構遅い(最速っぽくはない)こともあって、それよりは今回実装したもののほうが速い結果となった。

ただし、EUC-JPはともかくUTF系はデコード用のトライのサイズがメガ単位になってしまっているので、常用するにはあまり向かないように思う。
また、UTF系は今回のようにわざわざ変換表を用意しなくても、特定のロジックに従えばユニコード値に変換できるので、そういった意味でもあまり利用価値はなさそう。
EUC-JPとかShift_JISに対しては有用かな。