B木: バランス具合
前回のB木の実装中にはほとんど気にしていなかったけど、どうやらB木は挿入のみなら常にバランス状態を維持できるようになっているようだ(おそらく)。
今回はB木のバランス具合を確かめるために試したこと(+考えたこと)のメモ。
※ いつもの通り正しくない可能性が多いにあるので、ちゃんと知りたい人はどこか別の信頼性のある情報を参照のこと
B木の成長過程
0から49までの値をキーとして昇順に挿入した場合に木の形がどうなるか。
下の図(GIFアニメ)を参照。
B木のオーダー数*1は四。
※ 各ノードの数字はその要素のキーを表す。要素の値は非表示。キーが"Hxxx"なっているのは先頭のメタノード。
※ 下の図では実装に合わせて先頭のメタノードを明示的に表示しているため、Wikipediaやその他一般的(?)に見られるB木の図とは若干形が異なる。
キーを昇順に挿入した場合、(一番単純に実装した)ニ分木では縮退が発生し"木"というよりはソート済みのリンクリストのようになってしまうが、B木の場合は木の形が常に(?)バランスしていることが分かる。
挿入順序をランダムにしてみても結果は同様。
B木の挿入処理は、
- 常に末端のノード(要素)を追加 == 子ノードの追加
- 子ノードの数が上限に達したら、より小さい/中央(基準)/より大きい、の三つに分割
- 分割後、中央(基準)ノードは親ノードへと昇格
ということを繰り返しているだけなのに、これほど上手くバランスするのが見ていて少し不思議な感じがする。
三番目の「基準ノードの昇格」というのは、一つ上のレベルから見たら、子ノードの追加*2に他ならないので、結局どのレベルでも「要素追加。規定数に達したら分割。その内一つを親ノードに昇格。」ということを繰り返していることになる、のかな。
で、その各「追加。分割。昇格。」処理の昇格の時点で、木の形は常に局所的にはバランスしていることになる。
※ 局所的にみれば、昇格終了後の木の高さ=2と、考えることができる。どのレベルであれ「高さ=1の木に要素を追加。要素を三つに分割。バランスされた高さ=2の木ができる。」ということの繰り返し。
加えて、その分割方法の性質上、あるノードの子ノードの数は常にオーダー数/2以上*3となる。
この二つの不変項*4が組み合わさっているために、B木は挿入のみなら常にバランスした状態が保たれることになる(のかもしれない)。
gifアニメ作成方法
上のgifアニメの作成には以下のプログラムおよびコマンドを使用。
※ B木の実装は末尾を参照。前回から若干の修正あり。
;; 0〜49までの値(キー)をB木に昇順に挿入していく ;; その各段階でB木の内容をdotファイルに書き出し、gif画像を作成する ;; ※ 最終的に作られる50枚のgif画像は、後で結合されgifアニメとなる (loop WITH tree = (btree:make) FOR key FROM 0 BELOW 50 ; キーの値は0〜49 FOR basename = (format nil "/tmp/bt~2,'0d" key) ; 画像ファイル等は/tmp以下に作成する FOR dotfile = (format nil "~a.dot" basename) ; dotファイル FOR giffile = (format nil "~a.gif" basename) ; gifファイル DO ;; 要素挿入 (setf (btree:get key tree) :val) ; 要素の値は:valに固定 ;; B木をdot形式にして出力 (with-open-file (out dotfile :direction :output :if-exists :supersede) (btree:print-dot tree out)) ;; dotデータをgifに変換 (sb-ext:run-program "dot" `("-Tgif" ,dotfile ,(format nil "-o~a" giffile)) :search t) ;; dotファイル削除 (delete-file dotfile))
# 上で作成した50枚のgif画像を結合して、gifアニメを作成する # 1] 準備: サイズを合わせる $ cd tmp $ for f in bt*.gif do # 全ての画像を640x320、背景色白、中央寄せ、に変換する convert -background white -gravity center -resize 640x320 -extent 640x320 $f "r-${f}" done # 2] gifアニメ作成 $ convert -delay 100 -loop 0 r-bt*.gif btree.gif
ソースコード
前回からの変更点は次の二つ。
- メタノードの名前を"HEAD"から"H"+ユニークID形式に変更
- B木インスタンスをもとにdotデータを出力する関数を追加
(defpackage btree (:use :common-lisp) (:shadow :common-lisp get set remove) (:export make get remove print-dot)) (in-package :btree) (defun return-nil (&rest _) (declare (ignore _)) nil) (defun identity3 (_1 _2 x) (declare (ignore _1 _2)) x) (defconstant +NODE-CHILDREN-LIMIT+ 5) (defstruct node key value (children '() :type list)) (defun make-root-node () (make-node :key :root :children (list (make-node :key (gensym "H"))))) ; 修正: メタノードの名前がユニークになるようgensymを使用 (defstruct btree (root-node t :type node) (test #'< :type function)) (defun make (&key (test #'<)) (make-btree :root-node (make-root-node) :test test)) (defun find-node-case (key btree &key on-success (on-failure #'return-nil) (on-return #'identity3) (on-root-return #'identity)) (declare (function on-success on-failure on-return on-root-return)) (with-slots (root-node test) btree (labels ((recur (parent) (loop FOR prev ON (node-children parent) FOR node = (second prev) WHILE (and node (funcall test (node-key node) key)) FINALLY (return (cond ((and node (not (funcall test key (node-key node)))) (funcall on-success parent prev node)) ((node-children (car prev)) (funcall on-return parent prev (recur (car prev)))) (t (funcall on-failure parent prev))))))) (funcall on-root-return (recur root-node))))) (defun get (key btree) (find-node-case key btree :on-success (lambda (_1 _2 node) (declare (ignore _1 _2)) (node-value node)))) (defun node-split (nodes) (when (> (length nodes) +NODE-CHILDREN-LIMIT+) (let* ((mid (floor (length nodes) 2)) (split-left-tail (nthcdr (1- mid) nodes)) (split-node (nth mid nodes)) (split-right (nthcdr (1+ mid) nodes))) (setf (cdr split-left-tail) nil) (setf (node-children split-node) (cons (make-node :key (gensym "H") :children (node-children split-node)) ; 修正: メタノードの名前がユニークになるようgensymを使用 split-right)) split-node))) (defun insert-node (parent prev node) (push node (cdr prev)) (node-split (node-children parent))) (defun set (key value btree) (with-slots (root-node) btree (find-node-case key btree :on-success (lambda (_1 _2 node) (declare (ignore _1 _2)) (setf (node-value node) value) nil) :on-failure (lambda (parent prev) (insert-node parent prev (make-node :key key :value value))) :on-return (lambda (parent prev split-node) (when split-node (insert-node parent prev split-node))) :on-root-return (lambda (split-node) (when split-node (let* ((new-root (make-root-node)) (new-root-child (car (node-children new-root)))) (setf (node-children new-root-child) (node-children root-node)) (insert-node new-root-child (node-children new-root) split-node) (setf root-node new-root)))))) value) (defsetf get (key btree) (new-value) `(set ,key ,new-value ,btree)) (defmacro cut-nobranch-node! (node) `(when (= 1 (length #1=(node-children ,node))) (setf #1# (node-children (first #1#))))) (defun pickup-minnode (node) (let ((fst (first #1=(node-children node)))) (if (node-children fst) (pickup-minnode fst) (let ((min (second #1#))) (setf (cdr #1#) (cddr #1#) (node-children fst) (node-children min)) (cut-nobranch-node! node) min)))) (defun replace-minnode-to-root (node) (let ((min (pickup-minnode node))) (setf (node-children min) (node-children node)) min)) (defun remove (key btree) (with-slots (root-node) btree (find-node-case key btree :on-success (lambda (parent prev node) (if (node-children node) (setf (second prev) (replace-minnode-to-root node)) (progn (setf (cdr prev) (cddr prev)) (unless (eq parent root-node) (cut-nobranch-node! parent)))))))) ;; 追加: btreeに対応するdotデータをstreamに出力 (defun print-dot (btree &optional (stream t)) (labels ((recur (node) (loop WITH nid = (node-key node) FOR child IN (node-children node) FOR cid = (node-key child) DO (format stream "~A -> ~A;~%" nid cid) (recur child)))) (format stream "digraph dtree {~%") (format stream "graph [rankdir=RL,rotate=90];~%") (recur (btree-root-node btree)) (format stream "}~%")))
