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

LOUDS++(4): bit-vector

common lisp algorithm

LOUDSの四回目。
selectおよびrankが効率的に行えるビット配列(bit-vector)の実装。

参考

一応参考にしたのは、次の二つの論文

  • 『A Simple Optimal Representation for Balanced Parentheses』
  • 『Compressed Prefix Sums』

ただし、良く分からないところや、詳細が省略されているところや、もっと簡潔にできそうなところなどが(少なからず)あったため、以降に載せるbit-vectorの実装は、この二つの論文で説明されているそれとは、(少なからず)異なっている。
あくまでも「参考」にして、後は自分好みに実装した、といった感じ。

実装するもの

以降では、select1とrank1を備えたbit-vectorを実装する。
select0およびrank0を実装しない理由は以下の通り。

  • select0は、LOUDS++では不要なため
  • rank0の値は、rank1があれば、右の式のようにして簡単に求められるため: (1+ (- pos (rank1 pos)))

準備

操作対象となるビット列。

(defvar *bits* (coerce (loop REPEAT 1000 COLLECT (if (zerop (random 2)) 1 0)) 'bit-vector))
--> *BITS*

*bits*  
--> #*0001101001111001010010011100111110100010011111111101111000000100100000100001101110010010010100
      0100000100000000000011111110010111110011100001101011100101101010000010011001110010100000000001
      0010110101001111111000001101110100011011111100000000111111011010001100000001100011100001010100
      1001000100100000000000001110110101110101101101011000110101000000000001010110101000001110010000
      1010100010011101101010001101001001101111111100101001011100000011001001111110011111001101001001
      0101100011100100100100011011110011010110010010001000001101111001101001000110011111110010001111
      1011011011011101101110100110110000100001010000111001011101010011000111110010111101111010000110
      0100000111010011101001101111101001100010110010100000001111111010101000011111010100110011100101
      0001110100010110101111100001110001010110010011100000111100001000011111000111111010100001011011
      0001000010011101001010110101101010011000111010110010101011111010000100001111001010011000010001
      100011000001011101101000010111010011010001110010101010100011

実装1: O(N), Nビット

まずは、これまで使ってきたselectおよびrankの実装を再掲する。※ 細かい修正はあるが、基本的に同じもの

;; ビット列bits内のnth番目の1ビットの位置を返す
(defun select1 (nth bits)
  (loop FOR index FROM 0
        FOR bit ACROSS bits
    WHEN (= 1 bit)
    DO (when (zerop (decf nth))
         (return index))))

;; ビット列bits内で位置indexよりも前にある1ビットの数を返す
(defun rank1 (index bits)
  (loop FOR i FROM 0 TO index
        FOR bit ACROSS bits
    WHEN (= 1 bit) SUM 1))

;;; 例
(select1 100 *bits*)
--> 217

(rank1 100 *bits*)
--> 46

この実装では、定義から自明な通り、selectおよびrankにN(ビット列のサイズ)に比例した時間が掛る。
ただし、他の実装のような補助的なデータ構造が必要ではないので、ビット列自身のための領域しか消費しない。

実装2: O(1), N*32+N*16ビット

次は、一度の配列アクセスだけで、select1およびrank1が求められる実装。

;;; bit-vector構築時にselect1/rank1の全ての値を計算し、テーブルに格納しておく

(deftype uint32 () '(unsigned-byte 32))

(defstruct bit-vector~
  (select-table #() :type (simple-array uint32))
  (rank-table   #() :type (simple-array uint32)))プレビュープレビュー  

(defun build-bit-vector~ (bits)
  (make-bit-vector~
   :select-table (loop FOR nth FROM 1 TO (count 1 bits)        ;; 全てのselect1の値をあらかじめ計算しておく
                       COLLECT (select1 nth bits) INTO list    ;; (count 1 bits)*32ビット
                       FINALLY (return (coerce list '(vector uint32))))

   :rank-table   (loop FOR index FROM 0 BELOW (length bits)    ;; 全てのrank1の値をあらかじめ計算しておく
                       COLLECT (rank1 index bits) INTO list    ;; N*32ビット
                       FINALLY (return (coerce list '(vector uint32))))))

(defun select1~ (nth bit-vector2)
  (with-slots (select-table) bit-vector2
    (aref select-table (1- nth))))

(defun rank1~ (index bit-vector2)
  (with-slots (rank-table) bit-vector2
    (aref rank-table index)))


;;; 例
(defvar *bv~* (build-bit-vector~ *bits*))
(setf *print-length* 100)

*bv~*
--> #S(BIT-VECTOR~
   :SELECT-TABLE #(3 4 6 9 10 11 12 15 17 20 23 24 25 28 29 30 31 32 34 38 41
                   42 43 44 45 46 47 48 49 51 52 53 54 61 64 70 75 76 78 79 80
                   83 86 89 91 95 101 114 115 116 117 118 119 120 123 125 126
                   127 128 129 132 133 134 139 140 142 144 145 146 149 151 152
                   154 156 162 165 166 169 170 171 174 176 187 190 192 193 195
                   197 200 201 202 203 204 205 206 212 213 215 216 217 ...)
   :RANK-TABLE #(0 0 0 0 1 2 2 3 3 3 4 5 6 7 7 7 8 8 9 9 9 10 10 10 11 12 13 13
                 13 14 15 16 17 18 18 19 19 19 19 20 20 20 21 22 23 24 25 26 27
                 28 29 29 30 31 32 33 33 33 33 33 33 33 34 34 34 35 35 35 35 35
                 35 36 36 36 36 36 37 38 38 39 40 41 41 41 42 42 42 43 43 43 44
                 44 45 45 45 45 46 46 46 46 ...))

(select1~ 100 *bv~*)
--> 217

(rank1~ 100 *bv~*)
--> 46

これだと、あらかじめ配列に保存しておいた値を取り出すだけなので処理は高速だが、rank1用の配列に32*Nビット、select1用の配列に(平均して)32*N/2ビットの領域が必要になってしまい、(LOUDSにおいて)木をわざわざビット列で表現する(空間効率が極めて良いという)メリットが相殺されてしまう。

実装3: O(log(N)), N*1.5ビット

実装3は、実装1と実装2を組み合わせたような方法で、基本的には次のような考えに基づいている。

  • 事前に間隔をあけてselect1/rank1の値を計算しておく
  • 実際のselect1/rank1の値は、計算済みの値 + 未計算の差分部分の計算、を組み合わせることで求める
    • 計算済みの値は、O(1)で取得可能   ※計算済み配列[引数/間隔]
    • 未計算部分の計算は、最大でO(間隔の広さ)=O(1)で済む/span>

つまり、大まかな値を実装2の方法(配列アクセス)で取得しておき、細かい値は実装1の方法(間隔の広さ分のビット列の走査)で取得する、といったような方法。
※ 実装3は、間隔をNにすれば実装1に、間隔を1とすれば実装2に、概念的には等しくなる

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; 実装3: bit-vector構築部分

;;;;;;;;
;;; 定数
;; 間隔の広さ
;; ビット列は各間隔ごとに分割され、分割された各ビット列は「ブロック」と呼ばれる
(defconstant +BLOCK-SIZE+ 64)  

;;;;;;;;;;
;;; 型定義
(deftype uint32 () '(unsigned-byte 32))
(deftype uint64 () '(unsigned-byte 64))

;;;;;;;;;;;;;;
;;; 構造体定義
(defstruct bit-vector~~
  (blocks                   t :type (simple-array uint64))   ; 各間隔ごとに分割されたビット列 ※1
  (block-precede-1bit-count t :type (simple-array uint32)))  ; 各ブロックよりも前にある1ビットの数 ※2

; ※1 uint64型にエンコードされている
;       ex. (bit bits x) = (ldb (byte 1 x) bits-encoded-uint64) 
;
; ※2 これは(rank1 ブロックの開始位置 bits)に等しい
;     block-precede-1bit-countは、実装2でのrank-tableから一定間隔ごとに値を抽出したものに等しい

;;;;;;;;;;;;;;;;;;
;;; bit-vector構築
;; ビット列からbit-vectorを作成する
(defun build-bit-vector~~ (bits)
  (let ((bit-blocks (make-bit-blocks bits)))  ; ブロックに分割されてビット列を取得する
    (make-bit-vector~~
     :blocks                   (make-blocks bit-blocks)                      ; uint64にエンコードされたブロック列を取得する
     :block-precede-1bit-count (make-block-precede-1bit-count bit-blocks)))) ; 各ブロックの前にある1ビットの数を取得する

;; ビット列をブロックに分割する
(defun make-bit-blocks (bits)
  (divide-bits bits +BLOCK-SIZE+))

;; ビット列をblock-sizeごとに分割する
(defun divide-bits (bits block-size &aux (len (length bits)))
  (loop FOR start FROM 0 BELOW len BY block-size
        COLLECT (subseq bits start (min (+ start block-size) len)) INTO bits-list
        FINALLY (return (coerce bits-list 'vector))))

;; ビット列形式のブロックを、uint64形式のブロックに変換する
(defun make-blocks (bit-blocks)
  (map '(vector uint64) #'bits-to-num bit-blocks))

;; ビット列を数値(表現)に変換する
(defun bits-to-num (bits)
  (loop FOR i      FROM 0 BELOW (length bits)
        FOR offset FROM 0
    SUM (ash (bit bits i) offset)))

;; 各ブロックの前にある1ビットの数を取得する
(defun make-block-precede-1bit-count (bit-blocks)
  (loop FOR bits ACROSS bit-blocks
        FOR count = (count 1 bits)
    COLLECT total INTO 0bit-counts
    SUM     count INTO total
    FINALLY (return (coerce `(,@0bit-counts ,total) '(vector uint32)))))


;;;;;;
;;; 例
(defvar *bv~~* (build-bit-vector~~ *bits*))
--> *BV~~*

*bv~~*
--> #S(BIT-VECTOR~~
     ;; blockの使用領域: N/64*64 = Nビット
     :BLOCKS #(2340744007741775448 16860351244727343169 5188514437474506867
               14249108834993864491 13464637063855370624 1515955344026289846
               16483431165819819449 11155242871024825319 13177272997182419012
               5732148411449435611 5555609703604127215 7545965012038549249
               9096726922232739965 3874879865564051077 7963235531331082197
               847532706721)
     ;; block-pre...の使用領域: N/64*32 = 0.5Nビット
     :BLOCK-PRECEDE-1BIT-COUNT #(0 34 58 84 120 142 166 200 234 268 300 334 366
                                 399 429 458 458))

この時点での実装3の留意点。

  • ビット列を64ビットの数値表現で保持
    • これは単純に効率のため
      • common-lisp:bit-vector(or ビット列一般)を走査するより、数値に対してビット演算を適用する方が高速
      • 数値表現の方が、common-lisp:bit-vector(or ビット列一般)よりもサイズ的なオーバーヘッドが少ない(おそらく)
  • 上の各数値は、ビット列の分割された各ブロックに対応
  • 各ブロックごとに、それより前方にある1ビットの数を保持しておく
  • 使用領域は、1.5Nビット
;;;; 実装3: select1/rank1実装部分

;;;;;;;;;;;
;;; select1
(defun select1~~ (nth bit-vector~~)
  (with-slots (block-precede-1bit-count) bit-vector~~
    ;; nth番目の1が属するブロックを、二分探索で求める
    ;; # O(log(ブロック数)) = O(log(N))
    (multiple-value-bind (block-beg block-end) (target-block-bound nth bit-vector~~)
      (loop FOR block-num = (+ block-beg (floor (- block-end block-beg) 2))
            FOR start = (aref block-precede-1bit-count block-num)
            FOR end   = (1+ (aref block-precede-1bit-count (1+ block-num)))
        WHEN (< start nth end) DO (loop-finish)
        WHEN (<= nth start)    DO (setf block-end block-num)
        WHEN (>= nth end)      DO (setf block-beg block-num)

        ;; nth番目の1ビットの位置(= selec1)の求め方:
        ;; この1ビットが属するブロックをブロックAとして、以下のように求められる
        ;;   ブロックAの開始位置 + ブロックA内でのnthの位置 
        FINALLY
        ;; # O(log(1)) 
        (return (+ (* block-num +BLOCK-SIZE+)                                 ; ブロックの開始位置
                   (block-select1 (- nth start) block-num bit-vector~~))))))) ; nth番目の1ビットのブロック内での位置

;; 二分探索の始点と終点を返す
;;  - 実装3では、(values 0 ブロック数=ビット列の長さ/+BLOCK-SIZE+)、に固定
;;  - 実装4では、二分探索のステップ数を抑えるために、この関数の定義が変更される
(defun target-block-bound (nth bit-vector~~)
  (declare (ignore nth))
  (with-slots (block-precede-1bit-count) bit-vector~~
    (values 0 (length block-precede-1bit-count))))

;; ブロックを返す
(defun get-block (block-num bit-vector~~)
  (with-slots (blocks) bit-vector~~
    (aref blocks block-num)))

;; ブロック一つに対して、select1を行う
(defun block-select1 (nth block-num bit-vector~~)
  (labels ((impl (beg end block)
             (let* ((m (+ beg (floor (- end beg) 2)))
                    (i (logcount (ldb (byte m 0) block))))
               (cond ((= nth i) (1- (integer-length (ldb (byte m 0) block))))
                     ((< nth i) (impl beg m block))
                     (t         (impl m end block))))))
    (impl 0 (* +BLOCK-SIZE+ 2) (get-block block-num bit-vector~~))))

;;;;;;;;;
;;; rank1
(defun rank1~~ (index bit-vector~~)
  (multiple-value-bind (block-num offset) (floor index +BLOCK-SIZE+)
    (with-slots (block-precede-1bit-count) bit-vector~~
      (let ((pre-1bit-count (aref block-precede-1bit-count block-num)))
        ;; rank1の求め方:
        ;; indexが属するブロックをブロックAとして
        ;;  ブロックAより前にある1ビットの数 + ブロックA内でindexより前にある1ビットの数
        ;; # O(log(1))
        (+ pre-1bit-count
           (block-rank1 offset block-num bit-vector~~))))))

;; ブロック一つに対して、rank1を行う
(defun block-rank1 (offset block-num bit-vector~~)
  (logcount (ldb (byte (1+ offset) 0) 
                 (get-block block-num bit-vector~~))))

;;;;;;
;;; 例
(select1~~ 100 *bv~~*)
--> 217

(rank1~~ 100 *bv~~*)
--> 46

実装4: O(1), N*2ビット

実装3では、select1でnth番目の1ビットが属するブロックを求めるために、全てのブロックを対象として二分探索を行う必要があり*1、そのために処理ステップ(?)がO(log(N))になってしまっていた。
実装4では、bit-vector~~にフィールドを追加して、この二分探索をほとんどの場合にO(log(1))で行えるように修正する。

;;;; 実装4: bit-vector構築部分

;;;;;;;;
;;; 定数
(defconstant +SELECT-TABLE-INTERVAL+ 64)  ; 実装2のselect-table(に似たもの)から値を抽出する間隔

;;;;;;;;;;;;;;
;;; 構造体定義
(defstruct bit-vector~~~
  (blocks                   t :type (simple-array uint64))
  (block-precede-1bit-count t :type (simple-array uint32))
  (select-table             t :type (simple-array uint32))) ; 適切な名前が思い浮かばない... ※3

;; ※3 以下のような配列
;;     - 実装2のselect-tableから、+SELECT-TABLE-INTERVAL+ごとに値を抽出
;;     - ただし、配列の各要素はn番目の1ビットの位置ではなく、それが属するブロック番号を示す
;;       - つまり、実装2のselect-tableの値を+BLOCK-SIZE+で割った値が入っている

;; bit-vector作成: select-table以外は実装3と同様
(defun build-bit-vector~~~ (bits)
  (let ((bit-blocks (make-bit-blocks bits)))
    (make-bit-vector~~~
     :blocks                   (make-blocks bit-blocks)
     :block-precede-1bit-count (make-block-precede-1bit-count bit-blocks)
     :select-table             (make-select-table bits))))

;; select-table作成
(defun make-select-table (bits)
  (loop WITH nth = 0         ; = (select1 index bits)の値
        FOR index FROM 0
        FOR bit ACROSS bits
    WHEN (and (= bit 1)
              (zerop (mod (incf nth) +SELECT-TABLE-INTERVAL+)))    ; nthが、+SELECT-TABLE-INTERVAL+の倍数になった場合
    COLLECT (floor index +BLOCK-SIZE+) INTO list                   ; リストに追加する
    FINALLY 
    (let ((block-count (ceiling (length bits) +BLOCK-SIZE+)))      ; リストの最後に、ブロックの数を追加する(番兵値)
      (return (coerce `(0 ,@list ,block-count) '(vector uint32)))))) ; uint32の配列に変換  

;;;;;;
;;; 例
(defvar *bv~~~* (build-bit-vector~~~ *bits*))
--> *BV~~~*

*bv~~~*
--> #S(BIT-VECTOR~~~
       ;; blockの使用領域: N/64*64 = Nビット
       :BLOCKS #(2340744007741775448 16860351244727343169 5188514437474506867
                 14249108834993864491 13464637063855370624 1515955344026289846
                 16483431165819819449 11155242871024825319 13177272997182419012
                 5732148411449435611 5555609703604127215 7545965012038549249
                 9096726922232739965 3874879865564051077 7963235531331082197
                 847532706721)
       ;; block-pre...の使用領域: N/64*32 = 0.5Nビット
       :BLOCK-PRECEDE-1BIT-COUNT #(0 34 58 84 120 142 166 200 234 268 300 334 366
                                   399 429 458 458)
       ;; select-tableの使用領域: (count 1 bits)/64*32 = 約0.25Nビット ※4
       :SELECT-TABLE #(2 4 6 8 10 12 14 16))

(count 1 bits)
--> 477

; ※4 この値は、実装2のselect-tableと同様に、ビット配列中に占める1ビットの割合に左右される
;     正確には、(N*ビット配列中に占める1ビットの割合)/64*32ビット
;;;; 実装4: select1/rank1実装部分

;; select1/rank1: 実装3とほぼ同様
(defun select1~~~ (nth bit-vector~~~)
  #| select1~~と同様 |# )
(defun rank1~~~ (index bit-vector~~~)
  #| rank1~~と同様 |# )

;; select1でnthが属するブロックを求める二分探索の、最初の始点と終点を返す
;;
;; 実装3と唯一異なる関数
;; select-tableを用いることで、(実装3に比べ)多くの場合に二分探索の回数をO(1)に抑えることが可能となる
;;   特定のnthが属するブロックの範囲を限定できるため
;; 二分探索の回数は、ビット列内の0ビットと1ビットの分布の仕方に依存※5する
;; 目安は以下の通り
;;  - ブロック内の0ビットと1ビットの数がほぼ等しいビット列の場合: O(log(2)) => O(1)
;;  - ほとんど1ビットしかないビット列の場合:                      O(log(1)) => O(1)
;;  - ほとんど0ビットしかないビット列の場合:                      O(log(N))  ※ この場合は、実装3と等しくなる
(defun target-block-bound (nth bit-vector~~~)  ; XXX: 実装3と名前がかぶっている...
  (with-slots (select-table) bit-vector~~~
    (let ((idx (floor nth +SELECT-TABLE-INTERVAL+)))
      (values (+ 0 (aref select-table (+ 0 idx)))     
              (+ 1 (aref select-table (+ 1 idx)))))))

; ※5 言い換えれば、select-tableの隣接する二つ値の差分、に依存する
;     select-table[X](始点)からselect-table[X+1]+1(終点)の間で二分探索を行うので、この二つの値の差が小さい方が探索回数が少なくて済む

;;;;;;
;;; 例
(select1~~~ 100 *bv~~~*)
--> 217

(rank1~~~ 100 *bv~~~*)
--> 46

実装3に平均0.25Nビットを追加すること(= 平均1.75Nビット使用)で、だいたいの場合にselect1/rank1をO(1)で実行できるbit-vectorが出来た。
※ ちなみに、select0もサポートした場合、実装4の使用領域は(最悪/最善を問わず)常に2Nビットとなる。

実装4のbit-vectorのselect1のステップ数は、ビット列の長さというよりは、ビット分布のパターンに依存し、1ビットが極めて疎な列に対しては若干効率が悪くなる。
それが実用上どの程度問題になるかは、ちゃんと調べてないので分からないが、LOUDS++での使用に限れば、ほとんど問題がないのではないかと考えている(確固とした根拠は無し)

###

ここまででbit-vectorの実装は終了。
LOUDS++は、要素数Mの木を表現するために(約)長さMのビット列が二つ必要。
そのビット列を、今回作成したbit-vectorを使って実装すれば、約4Mビットで木*2を表現できることになる。

ソースコード

実装4の元になったソースコードを下に載せておく。
基本的には実装4と同じだが、以下の点は異なる。

  • sbcl用の最適化宣言付き
  • 各ブロックをuint64ではなく、二つのuint32で表現
  • 実装4の前に書かれたソースであるため、関数や変数などの名前に若干差異あり
;;;; sbcl-1.0.38
(defvar *fastest* '(optimize (speed 3) (safety 0) (compilation-speed 0) (debug 1)))

(defconstant +BLOCK-SIZE+ 64)
(defconstant +WORD-SIZE+  32)
(defconstant +SELECT-INDEX-INTERVAL+ 64)

(deftype block-number () '(mod #.(floor array-total-size-limit +BLOCK-SIZE+)))
(deftype array-index () '(mod #.array-total-size-limit))
(deftype positive-fixnum () '(mod #.most-positive-fixnum))
(deftype uint32 () '(unsigned-byte 32))

(defstruct (bitvector (:conc-name ""))
  (blocks                   t :type (simple-array uint32))
  (block-precede-1bit-count t :type (simple-array positive-fixnum))
  (select-indices           t :type (simple-array block-number)))

(defun bits-to-num (bits &optional (start 0) (end (length bits)))
  (loop FOR i      FROM start BELOW (min end (length bits))
        FOR offset FROM 0
        SUM (ash (bit bits i) offset)))

(defun divide-bit-string (bit-string block-size &aux (len (length bit-string)))
  (loop FOR start FROM 0 BELOW len BY block-size
        COLLECT (subseq bit-string start (min (+ start block-size) len)) INTO bits-list
        FINALLY (return (coerce bits-list 'vector))))

(defun make-bit-blocks (bit-string)
  (divide-bit-string bit-string +BLOCK-SIZE+))

(defun make-blocks (bit-blocks)
  (loop FOR bits ACROSS bit-blocks
    APPEND `(,(bits-to-num bits 0 +WORD-SIZE+)
             ,(bits-to-num bits +WORD-SIZE+ +BLOCK-SIZE+)) INTO block-list
    FINALLY (return (coerce block-list '(vector uint32)))))

(defun make-block-precede-1bit-count (bit-blocks)
  (loop FOR bits ACROSS bit-blocks
        FOR count = (count 1 bits)
    COLLECT total INTO 1bit-counts
    SUM count     INTO total
    FINALLY (return (coerce `(,@1bit-counts ,total) '(vector positive-fixnum)))))

(defun make-select-indices-list (bit-blocks)
  (loop WITH index = 0
        WITH nth   = 0
        FOR bits ACROSS bit-blocks
    APPEND (loop FOR b ACROSS bits
             WHEN (and (incf index)
                       (= b 1)
                       (incf nth)
                       (zerop (mod nth +SELECT-INDEX-INTERVAL+)))
             COLLECT (floor (1- index) +BLOCK-SIZE+))
      INTO indices
    FINALLY (return (append (cons 0 indices)
                            `(,(length bit-blocks))))))

(defun make-select-indices (select-indices-list)
  (coerce select-indices-list '(vector block-number)))

(defun build-bitvector (bit-string)
  (let* ((bit-blocks (make-bit-blocks bit-string))
         (blocks     (make-blocks bit-blocks))
         (select-indices-list (make-select-indices-list bit-blocks)))
    (make-bitvector
     :select-indices           (make-select-indices select-indices-list)
     
     :blocks                   blocks
     :block-precede-1bit-count (make-block-precede-1bit-count bit-blocks))))

(declaim (inline get-block))
(declaim (ftype (function (block-number bitvector) (values uint32 uint32)) get-block))
(defun get-block (block-num bitvector)
  (with-slots (blocks) bitvector
    (values (aref blocks (+ 0 (* 2 block-num)))
            (aref blocks (+ 1 (* 2 block-num))))))

(declaim (inline block-select1)) 
(defun block-select1 (nth block-num bitvector)
  (labels ((impl (nth block beg end)
             (let* ((m (+ beg (floor (- end beg) 2)))
                    (i (logcount (ldb (byte m 0) block))))
               (declare ((mod 33) m))
               (cond ((= nth i) (1- (integer-length (ldb (byte m 0) block))))
                     ((< nth i) (impl nth block beg m))
                     (t         (impl nth block m end))))))
    (declare (ftype (function ((mod 65) uint32 (mod 33) (mod 65)) (mod 33)) impl))
    (multiple-value-bind (block-low block-high) (get-block block-num bitvector)
      (let ((i (logcount block-low)))
        (cond ((= nth i) (1- (integer-length block-low)))
              ((< nth i) (impl nth block-low 0 32))
              (t   (+ 32 (impl (- nth i) block-high 0 64))))))))

(declaim (inline target-block-bound))
(defun target-block-bound (nth bitvector)
  (with-slots (select-indices) bitvector
    (let ((idx (floor nth +SELECT-INDEX-INTERVAL+)))
      (values (+ 0 (aref select-indices (+ 0 idx)))
              (+ 1 (aref select-indices (+ 1 idx))))))) ; (values 0 (length ...))

(defun select1 (nth bitvector)
  (declare #.*fastest*
           (positive-fixnum nth)
           (bitvector bitvector))
  (with-slots (block-precede-1bit-count) bitvector
    (multiple-value-bind (block-beg block-end) (target-block-bound nth bitvector)
      (loop FOR block-num OF-TYPE block-number = (+ block-beg (floor (- block-end block-beg) 2))
            FOR start OF-TYPE positive-fixnum  = (aref block-precede-1bit-count block-num)
            FOR end   OF-TYPE positive-fixnum  = (1+ (aref block-precede-1bit-count (1+ block-num)))
        WHEN (< start nth end) DO (loop-finish)
        WHEN (<= nth start)    DO (setf block-end block-num)
        WHEN (>= nth end)      DO (setf block-beg block-num)
        FINALLY 
        (return (+ (* block-num +BLOCK-SIZE+) (block-select1 (- nth start) block-num bitvector)))))))

(declaim (inline block-rank1))
(defun block-rank1 (offset block-num bitvector)
  (multiple-value-bind (block-low block-high) (get-block block-num bitvector)
    (if (< offset 32)
        (logcount (ldb (byte (1+ offset) 0) block-low))
      (+ (logcount block-low)
         (logcount (ldb (byte (1+ (- offset 32)) 0) block-high))))))

(defun rank1 (index bitvector)
  (declare #.*fastest*
           (bitvector bitvector)
           (array-index index))
  (multiple-value-bind (block-num offset) (floor index +BLOCK-SIZE+)
    (with-slots (block-precede-1bit-count) bitvector
      (let ((pre-1bit-count (aref block-precede-1bit-count block-num)))
        (declare (positive-fixnum pre-1bit-count))
        (the positive-fixnum
             (+ pre-1bit-count (block-rank1 offset block-num bitvector)))))))

*1:実装3は、実装2でのrank-table(のサイズ節約版)を保持しているためrank1は高速に行えるが、select-tableに対応するものはないためselect1が若干非効率になっている。実装4は、select-tableの対応物的なものを提供し、この部分の高速化を図っている

*2:正確には木の構造。各要素に付随する値などの情報は、別に領域を確保する必要がある。表現可能なのは、木の各要素の親子兄弟関係のみ