base64エンコーダの改良

2015-03-07 · 3482 文字 · 7 分くらいで読めます

Common Lisp

tamuraです。

Lisp Meet Up presented by Shibuya.lisp #25 や Clack Meetup #1 に参加してみた結果、自分でもできる範囲で改良してみようと思い立ちました。とりあえず以前作ったBase64エンコード関数を改良してみます。

現在のアルゴリズム

1文字目を文字バッファへ格納する（ビット長8）
文字バッファから6ビット取り出す（ビット長2）
ビット長が6未満なので2文字目を文字バッファへ格納する（ビット長10）
文字バッファから6ビット取り出す（ビット長4）
ビット長が6未満なので3文字目を文字バッファへ格納する（ビット長12）
…

改良の方針

3文字づつ取り出せばビット長を見る必要がなくなる
3文字取り出せないときは特殊ルートに行けば良い
- しかもその特殊ルートは最後の1回しか発生しない
最初に文字列を数値のリストにしているが、arefで直接参照すればリストにする必要がない

目標

より速く
より少メモリで

処理対象の文字列の取得

3文字

(lambda (str x)
  (logior
    (ash (char-code (aref str x)) 16)
    (ash (char-code (aref str (1+ x))) 8)
    (char-code (aref str (+ 2 x)))))

2文字

(lambda (str x)
  (logior
    (ash (char-code (aref str x)) 8)
    (char-code (aref str (1+ x)))))

1文字

(lambda (str x)
  (char-code (aref str x)))

確認

aは16進数で#x61なのでabcは#x616263となります。

CL-USER> ; 3文字
; No value
CL-USER> (= (funcall #'(lambda (str x)
                         (logior
                          (ash (char-code (aref str x)) 16)
                          (ash (char-code (aref str (1+ x))) 8)
                          (char-code (aref str (+ 2 x)))))
                     "abcd"
                     0)
            #x616263)

T
CL-USER> ; 2文字
; No value
CL-USER> (= (funcall #'(lambda (str x)
                         (logior
                          (ash (char-code (aref str x)) 8)
                          (char-code (aref str (1+ x)))))
                     "abcd"
                     0)
            #x6162)

T
CL-USER> ; 1文字
; No value
CL-USER> (= (funcall #'(lambda (str x)
                         (char-code (aref str x)))
                     "abcd"
                     0)
            #x61)

T

ループ

3文字ずつ処理をするので、3で割り切れるところまで処理していきます。

(loop for i from 0 to (- len (mod len 3) 3) by 3
  do (print "x"))

こういう感じになっていれば大丈夫です。 REPLで確認していきます。

CL-USER> (funcall #'(lambda (len)
                      (loop for i from 0 to (- len (mod len 3) 3) by 3
                         do (print "x")))
                  3)

"x"
NIL
CL-USER> (funcall #'(lambda (len)
                      (loop for i from 0 to (- len (mod len 3) 3) by 3
                         do (print "x")))
                  4)

"x"
NIL
CL-USER> (funcall #'(lambda (len)
                      (loop for i from 0 to (- len (mod len 3) 3) by 3
                         do (print "x")))
                  5)

"x"
NIL
CL-USER> (funcall #'(lambda (len)
                      (loop for i from 0 to (- len (mod len 3) 3) by 3
                         do (print "x")))
                  6)

"x"
"x"
NIL
CL-USER> (funcall #'(lambda (len)
                      (loop for i from 0 to (- len (mod len 3) 3) by 3
                         do (print "x")))
                  7)

"x"
"x"
NIL

中締め part1

ここまでの結果をまとめます。

基本的に3文字ずつ処理する
arefを使って文字を直接参照する
3文字に満たない場合は特殊処理をする

コード

(lambda (str)
  (let ((len (length str)))
    (flet ((pick3 (x)
             (logior
              (ash (char-code (aref str x)) 16)
              (ash (char-code (aref str (1+ x))) 8)
              (char-code (aref str (+ 2 x)))))
           (pick2 (x)
             (logior
              (ash (char-code (aref str x)) 8)
              (char-code (aref str (1+ x)))))
           (pick1 (x)
             (char-code (aref str x))))
      ; 基本的に3文字処理
      (loop for i from 0 to (- len (mod len 3) 3) by 3
           do (print (pick3 i))))))

確認結果

CL-USER> (funcall #'(lambda (str)
                      (let ((len (length str)))
                        (flet ((pick3 (x)
                                 (logior
                                  (ash (char-code (aref str x)) 16)
                                  (ash (char-code (aref str (1+ x))) 8)
                                  (char-code (aref str (+ 2 x)))))
                               (pick2 (x)
                                 (logior
                                  (ash (char-code (aref str x)) 8)
                                  (char-code (aref str (1+ x)))))
                               (pick1 (x)
                                 (char-code (aref str x))))
                                        ; 基本的に3文字処理
                          (loop for i from 0 to (- len (mod len 3) 3) by 3
                             do (print (pick3 i))))))
                  "abcd")


6382179
NIL
CL-USER> #x616263
6382179

エンコード

3文字

3文字(24bit)をエンコードすると6bitの値が4個生成されます。

(ldb (byte 6 18) x)
(ldb (byte 6 12) x)
(ldb (byte 6 6) x)
(ldb (byte 6 0) x)

これでOKです。ちょっとやってみます。

CL-USER> (ldb (byte 6 18) 6382179)
24
CL-USER> (ldb (byte 6 12) 6382179)
22
CL-USER> (ldb (byte 6 6) 6382179)
9
CL-USER> (ldb (byte 6 0) 6382179)
35

これを文字に変換するとこうなります。以前の記事と同じ結果になっています。

CL-USER> (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" 24)
#\Y
CL-USER> (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" 22)
#\W
CL-USER> (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" 9)
#\J
CL-USER> (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" 35)
#\j

2文字

2文字(16bit)をエンコードすると6bitの値が3個生成されるようにします。具体的には2bit左にシフトして18bitにしてから計算を行います。

(let ((x (ash x 2)))
    (ldb (byte 6 12) x)
    (ldb (byte 6 6) x)
    (ldb (byte 6 0) x))

1文字

1文字(8bit)をエンコードすると6bitの値が2個生成されるようにします。具体的には4bit左にシフトして12bitにしてから計算を行います。

(let ((x (ash x 4)))
    (ldb (byte 6 6) x)
    (ldb (byte 6 0) x))

変換

数値を文字に変換します。ここは以前のものと変わりません。arefを使います。

中締め part2

ここまでの結果をまとめます。

基本的に3文字ずつ処理する
arefを使って文字を直接参照する
3文字の場合
- 6bitの値を4個生成する
2文字の場合
- 6bitの値を3個生成する
1文字の場合
- 6bitの値を2個生成する
生成した値から変換後の文字を得る

コード

(lambda (str)
  (let* ((len (length str))
         (rem (mod len 3)))
    (flet ((pick3 (x)
             (logior
              (ash (char-code (aref str x)) 16)
              (ash (char-code (aref str (1+ x))) 8)
              (char-code (aref str (+ 2 x)))))
           (pick2 (x)
             (logior
              (ash (char-code (aref str x)) 8)
              (char-code (aref str (1+ x)))))
           (pick1 (x)
             (char-code (aref str x)))
           (to-enc (x)
             (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x)))
      ; 基本的に3文字処理
      (loop for i from 0 to (- len rem 3) by 3
         do
           (let ((x (pick3 i)))
             (to-enc (ldb (byte 6 18) x))
             (to-enc (ldb (byte 6 12) x))
             (to-enc (ldb (byte 6 6) x))
             (to-enc (ldb (byte 6 0) x)))
         finally
           (case rem
             (2 (let* ((2ch (pick2 (1+ i)))
                       (x (ash 2ch 2)))
                  (ldb (byte 6 12) x)
                  (ldb (byte 6 6) x)
                  (ldb (byte 6 0) x)))
             (1 (let* ((1ch (pick1 (1+ i)))
                       (x (ash 1ch 4)))
                  (ldb (byte 6 6) x)
                  (ldb (byte 6 0) x))))))))

無駄を省く

pick3やpick2などでlogiorでくっつけているのにldbで6bitずつに分割しています。処理対象となる文字数が3パターンしかないため、pick3などで6bitずつにしてみます。

3文字

3文字の場合は6bitの値を4個生成したいので

1文字目の6bit
2文字目の2bit + 2文字目の4bit
2文字目の4bit + 3文字目の2bit
3文字目の6bit

となります。値の生成と同時に文字への変換も行ってしまいます。

(lambda (str x)
  (let ((1st-ch (char-code (aref str x)))
        (2nd-ch (char-code (aref str (1+ x))))
        (3rd-ch (char-code (aref str (+ 2 x)))))
    (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
          (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                           (ldb (byte 4 4) 2nd-ch))))
          (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)
                           (ldb (byte 2 6) 3rd-ch))))
          (4th-enc (to-enc (ldb (byte 6 0) 3rd-ch))))
      (format T "~A~A~A~A" 1st-enc 2nd-enc 3rd-enc 4th-enc))))

2文字

2文字の場合は6bitの値を3個生成したいので

1文字目の6bit
1文字目の2bit + 2文字目の4bit
2文字目の4bit + ‘00’

となります。

(lambda (str x)
  (let ((1st-ch (char-code (aref str x)))
        (2nd-ch (char-code (aref str (1+ x)))))
    (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
          (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                           (ldb (byte 4 4) 2nd-ch))))
          (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)))))
      (format T "~A~A~A" 1st-enc 2nd-enc 3rd-enc))))

1文字

1文字の場合は6bitの値を2個生成したいので

1文字目の6bit
1文字目の2bit + ‘0000’

となります。

(lambda (str x)
  (let ((1st-ch (char-code (aref str x))))
    (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
          (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)))))
      (format T "~A~A" 1st-enc 2nd-enc))))

まとめる

これらをまとめます。先ほどより少し短くなります。

(lambda (str)
  (let* ((len (length str))
         (rem (mod len 3)))
    (labels ((to-enc (x)
             (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x))
           (pick3 (x)
             (let ((1st-ch (char-code (aref str x)))
                   (2nd-ch (char-code (aref str (1+ x))))
                   (3rd-ch (char-code (aref str (+ 2 x)))))
               (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                     (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                                              (ldb (byte 4 4) 2nd-ch))))
                     (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)
                                              (ldb (byte 2 6) 3rd-ch))))
                     (4th-enc (to-enc (ldb (byte 6 0) 3rd-ch))))
                 (format T "~A~A~A~A" 1st-enc 2nd-enc 3rd-enc 4th-enc))))
           (pick2 (x)
             (let ((1st-ch (char-code (aref str x)))
                   (2nd-ch (char-code (aref str (1+ x)))))
               (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                     (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                                              (ldb (byte 4 4) 2nd-ch))))
                     (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)))))
                 (format T "~A~A~A" 1st-enc 2nd-enc 3rd-enc))))
           (pick1 (x)
             (let ((1st-ch (char-code (aref str x))))
               (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                     (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)))))
                 (format T "~A~A" 1st-enc 2nd-enc)))))
      ; 基本的に3文字処理
      (loop for i from 0 to (- len rem 3) by 3
         do
           (pick3 i)
         finally
           (case rem
             (2 (pick2 i))
             (1 (pick1 i)))))))

4文字区切り

最後に4文字ごとに区切ってあまりを=で補います。これは、結果を格納するバッファに=を初期値として与えてバッファを作成すれば良さそうです。

(lambda (str)
  (let* ((len (length str))
         (rem (mod len 3))
         (buf (make-sequence 'string
                             (* (ceiling len 3) 4)
                             :initial-element #\\=)))
    (labels ((to-enc (x)
             (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x))
             (pick3 (x pos)
               (let ((1st-ch (char-code (aref str x)))
                     (2nd-ch (char-code (aref str (1+ x))))
                     (3rd-ch (char-code (aref str (+ 2 x)))))
                 (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                       (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                                                (ldb (byte 4 4) 2nd-ch))))
                       (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)
                                                (ldb (byte 2 6) 3rd-ch))))
                       (4th-enc (to-enc (ldb (byte 6 0) 3rd-ch))))
                   (setf (aref buf pos) 1st-enc)
                   (setf (aref buf (1+ pos)) 2nd-enc)
                   (setf (aref buf (+ 2 pos)) 3rd-enc)
                   (setf (aref buf (+ 3 pos)) 4th-enc))))
             (pick2 (x pos)
               (let ((1st-ch (char-code (aref str x)))
                     (2nd-ch (char-code (aref str (1+ x)))))
                 (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                       (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                                                (ldb (byte 4 4) 2nd-ch))))
                       (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)))))
                   (setf (aref buf pos) 1st-enc)
                   (setf (aref buf (1+ pos)) 2nd-enc)
                   (setf (aref buf (+ 2 pos)) 3rd-enc))))
             (pick1 (x pos)
               (let ((1st-ch (char-code (aref str x))))
                 (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                       (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)))))
                   (setf (aref buf pos) 1st-enc)
                   (setf (aref buf (1+ pos)) 2nd-enc)))))
      ; 基本的に3文字処理
      (loop for i from 0 to (- len rem 3) by 3
            for pos from 0 by 4
         do
           (pick3 i pos)
         finally
           (case rem
             (2 (pick2 i (+ 4 pos)))
             (1 (pick1 i (+ 4 pos)))))
      buf)))

関数化

関数化します。以前のものと比較したいのでbase64-enc-kaiとでもしておきます。

(defun base64-enc-kai (str)
  (let* ((len (length str))
         (rem (mod len 3))
         (buf (make-sequence 'string
                             (* (ceiling len 3) 4)
                             :initial-element #\\=)))
    (labels ((to-enc (x)
             (aref "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+-" x))
             (pick3 (x pos)
               (let ((1st-ch (char-code (aref str x)))
                     (2nd-ch (char-code (aref str (1+ x))))
                     (3rd-ch (char-code (aref str (+ 2 x)))))
                 (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                       (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                                                (ldb (byte 4 4) 2nd-ch))))
                       (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)
                                                (ldb (byte 2 6) 3rd-ch))))
                       (4th-enc (to-enc (ldb (byte 6 0) 3rd-ch))))
                   (setf (aref buf pos) 1st-enc)
                   (setf (aref buf (1+ pos)) 2nd-enc)
                   (setf (aref buf (+ 2 pos)) 3rd-enc)
                   (setf (aref buf (+ 3 pos)) 4th-enc))))
             (pick2 (x pos)
               (let ((1st-ch (char-code (aref str x)))
                     (2nd-ch (char-code (aref str (1+ x)))))
                 (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                       (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)
                                                (ldb (byte 4 4) 2nd-ch))))
                       (3rd-enc (to-enc (logior (ash (ldb (byte 4 0) 2nd-ch) 2)))))
                   (setf (aref buf pos) 1st-enc)
                   (setf (aref buf (1+ pos)) 2nd-enc)
                   (setf (aref buf (+ 2 pos)) 3rd-enc))))
             (pick1 (x pos)
               (let ((1st-ch (char-code (aref str x))))
                 (let ((1st-enc (to-enc (ldb (byte 6 2) 1st-ch)))
                       (2nd-enc (to-enc (logior (ash (ldb (byte 2 0) 1st-ch) 4)))))
                   (setf (aref buf pos) 1st-enc)
                   (setf (aref buf (1+ pos)) 2nd-enc)))))
      ; 基本的に3文字処理
      (loop for i from 0 to (- len rem 3) by 3
            for pos from 0 by 4
         do
           (pick3 i pos)
         finally
         finally
           (case rem
             (2 (pick2 i (+ 4 pos)))
             (1 (pick1 i (+ 4 pos)))))
      buf)))

ベンチをとる

今回は高速化、少メモリ化が目的だったので、 Cより高速なCommon Lispコードを書くにあるようにベンチマークを取ってみます。

CL-USER> (time
          (loop repeat 100000 do
               (base64-enc "abcdefgh")))
(LOOP REPEAT 100000 DO (BASE64-ENC "abcdefgh"))
took 998,000 microseconds (0.998000 seconds) to run.
       9,000 microseconds (0.009000 seconds, 0.90%) of which was spent in GC.
During that period, and with 8 available CPU cores,
     998,407 microseconds (0.998407 seconds) were spent in user mode
           0 microseconds (0.000000 seconds) were spent in system mode
 88,000,064 bytes of memory allocated.
NIL
CL-USER> (time
          (loop repeat 100000 do
               (base64-enc-kai "abcdefgh")))
(LOOP REPEAT 100000 DO (BASE64-ENC-KAI "abcdefgh"))
took 131,000 microseconds (0.131000 seconds) to run.
       3,000 microseconds (0.003000 seconds, 2.29%) of which was spent in GC.
During that period, and with 8 available CPU cores,
     124,801 microseconds (0.124801 seconds) were spent in user mode
           0 microseconds (0.000000 seconds) were spent in system mode
 6,400,064 bytes of memory allocated.
NIL

比較種類	base64-enc	base64-enc-kai
実行速度	998 ms	131 ms
メモリ(合計)	88 MB	6.4 MB
メモリ(1回分)	994 byte	128 byte

実行速度は約7.6倍の高速化、メモリは約13.6%まで減らすことができました。

いいわけ

今回一関数に無理やり詰め込んでいますが、 Quicklispのbootstrapで使うことを想定しているため、他のライブラリを使わず他の関数を書かないようにしてやっています。

プルリクエストするには以前のもので行ったほうが見通しがよくて良さそうです。 tamurashingo/quicklisp-bootstrap ProxyAuth対応中

目標