B木 - abwiki @ ウィキ (ActiveBasic非公式wiki)

Barance-Treeの略でデータ構造である木構造の一つ。

通常の2分探索木はデータを昇順ないし降順に入力すると左右どちらかにのみ枝が伸びるため、その後の探索が非常に遅くなる（O(n)程度）。そこでどのような順序でデータを入力しても左右のバランスを保つように工夫されたもの。 B木やその改良型であるB*木、B+木はデータベースなどで用いられている。

B木はページ単位（ベージ構造体）で情報を格納し、その内容は下記の通り。

• そのページが持つキーの個数n
• キーの値（n個：key[0], key[1]...key[n-1]）
• 各キーに付随する情報（n個：info[0], info[1]...info[n-1]）

　※下記プログラムでは省略

• 他のページへのポインタ（n+1個：branch[0], branch[1]...branch[n]）

各ページで格納するキーの数の上限を2*M個とすると、B木は以下の性質を持つ。

• 各ページはM<key<2*M個のキーを格納する（根に関しては0<key<2*Mとする）
• 各ページのキーは昇順に格納する
• branch[k]の示すページが含む全てのキーはkey[k-1]より大きく、key[k]より小さい
• branch[0]の示すページが含む全てのキーはkey[0]より小さい
• branch[n]の示すページが含む全てのキーはkey[n-1]より大きい
• 木の高さは一定である（根から葉までにたどるポインタ数は等しい）

検索 検索は根から初めてキーの大小関係を比べながらページをたどる。葉のポインタをNULLとすることで、キーが登録されているかの有無を判定できる。

挿入 挿入は検索と同じように根よりページをたどり、挿入したいキーが存在すれば何もしないで終了する。そうでなければ、NULLポインタの前の葉に新しいキーを格納する。キーが既に満杯である場合はキーの数が2M+1個になるため、小さい方のM個はそのままに大きい方のM個で新たなページをページを作り、残った中央の1個は上の階層のページに追加し、新しく作ったページへのポインタを追加する。上の階層でもキーの数がオーバーしたら、前記操作を繰り返す。

削除 葉で無いページの削除は、そのキーの次に大きいキーが必ず葉にあるので、両者を入れ替えることによって消去の操作を必ず葉で行うようにする。葉からキーを削除してキーの数がM個を下回った場合は、兄弟ノードでの再配列を行う。兄弟ノードがそれぞれM個のデータしか持っていない場合はこれを統合し、ページをひとつ減らす。

#N88BASIC
Const M = 1 ' 1ページのデータ数の上限の半分

TypeDef keytype = Integer ' 探索のキーの型
Type page ' ページの定義
n As Integer ' データ数
key[2 * M] As keytype ' キー
branch[2 * M] As *page ' 他ページへのポインタ
End Type

Dim root = NULL As *page ' B木の根
Dim key As keytype ' キー
Dim done As Long ' 論理型の変数(Long型で代用)
Dim deleted As Long
Dim undersize As Long
Dim newp As *page ' insert() の生成した新しいページ
Dim message As String ' 関数の返すメッセージ

'新しいページの生成
Function newpage() As *page
Dim p As *page

p = malloc(SizeOf(page))
If p = 0 Then
Print "メモリ不足."
Exit Sub
End If
newpage = p
End Function

'キー key をB木から探す
Sub search()
Dim p As *page
Dim k As Integer

p = root
While p <> NULL
k = 0
While k < p->n And p->key[k] < key
k = k + 1
Wend
If k < p->n And p->key[k] = key Then
message = "見つかりました."
Exit Sub
End If
p = p->branch[k]
Wend
message = "見つかりません."
End Sub

'key を p->key[k] に挿入
Sub insertitem(p As *page, k As Integer)
Dim i As Integer

For i = p->n To k + 1 Step -1
p->key[i] = p->key[i - 1]
p->branch[i + 1] = p->branch[i]
Next i
p->key[k] = key
p->branch[k + 1] = newp
p->n = p->n + 1
End Sub

'key を p->key[k] に挿入し, ページ p を割る
Sub split(p As *page, k As Integer)
Dim j As Integer
Dim m AS Integer
Dim q As *page

If k <= M Then
m = M
Else
m = M + 1
End If
q = newpage()
For j = m + 1 To 2 * M
q->key[j - m - 1] = p->key[j - 1]
q->branch[j - m] = p->branch[j]
Next j
q->n = 2 * M - m
p->n = m
If k <= M Then
insertitem(p, k)
Else
insertitem(q, k - m)
End If
key = p->key[p->n - 1]
q->branch[0] = p->branch[p->n]
p->n = p->n - 1
newp = q ' 新しいページを newp に入れて戻る
End Sub

'p から木を再帰的にたどって挿入
Sub insertsub(p As *page)
Dim k As Integer

If p = NULL Then
done = FALSE
newp = NULL
Exit Sub
End If

k = 0
While k < p->n And p->key[k] < key
k = k + 1
Wend
If k < p->n And p->key[k] = key Then
message = "もう登録されています"
done = TRUE
Exit Sub
End If
insertsub(p->branch[k])
If done Then Exit Sub
If p->n < 2 * M Then ' ページが割れない場合
insertitem(p, k)
done = TRUE
Else ' ページが割れる場合
split(p, k)
done = FALSE
End If
End Sub

'キー key をB木に挿入
Sub insert()
Dim p As *page

message = "登録しました"
insertsub(root)
if done Then Exit Sub return
p = newpage()
p->n = 1
p->key[0] = key
p->branch[0] = root
p->branch[1] = newp
root = p
End Sub

'p->key[k], p->branch[k+1] を外す.
'ページが小さくなりすぎたら undersize フラグを立てる.
Sub removeitem(p As *page, k As Integer)
k = k + 1
While k < p->n
p->key[k - 1] = p->key[k]
p->branch[k] = p->branch[k + 1]
k = k + 1
Wend
p->n = p->n - 1
undersize = p->n < M
End Sub

'p->branch[k - 1] の最右要素を p->key[k - 1] 経由で p->branch[k] に動かす
Sub moveright(p As *page, k As Integer)
Dim i As Integer
Dim j As Integer
Dim left As *page
Dim right As *page

left = p->branch[k - 1]
right = p->branch[k]
For j = right->n To 1 Step -1
right->key[j] = right->key[j - 1]
right->branch[j + 1] = right->branch[j]
Next j
right->branch[1] = right->branch[0]
right->n = right->n + 1
right->key[0] = p->key[k - 1]
p->key[k - 1] = left->key[left->n - 1]
right->branch[0] = left->branch[left->n]
left->n = left->n - 1
End Sub

'p->branch[k] の最左要素を p->key[k - 1] 経由で p->branch[k - 1] に動かす
Sub moveleft(p As *page, k As Integer)
Dim j As Integer
Dim left As *page
Dim right As *page

left = p->branch[k - 1]
right = p->branch[k]
left->n = left->n + 1
left->key[left->n - 1] = p->key[k - 1]
left->branch[left->n] = right->branch[0]
p->key[k - 1] = right->key[0]
right->branch[0] = right->branch[1]
right->n = right->n - 1
For j = 1 To right->n
right->key[j - 1] = right->key[j]
right->branch[j] = right->branch[j + 1]
Next j
End Sub

'p->branch[k - 1], p->branch[k] を結合する
Sub combine(p As *page, k As Integer)
Dim j As Integer
Dim left As *page
Dim right As *page

right = p->branch[k]
left = p->branch[k - 1]
left->n = left->n + 1
left->key[left->n - 1] = p->key[k - 1]
left->branch[left->n] = right->branch[0]
For j = 1 To right->n
left->n = left->n + 1
left->key[left->n - 1] = right->key[j - 1]
left->branch[left->n] = right->branch[j]
Next j
removeitem(p, k - 1)
free(right)
End Sub

'小さくなりすぎたページ p->branch[k] を修復する
Sub restore(p As *page, k As Integer)
undersize = FALSE
If k > 0 Then
If p->branch[k - 1]->n > M Then
moveright(p, k)
Else
combine(p, k)
End If
Else
If p->branch[1]->n > M Then
moveleft(p, 1)
Else
combine(p, 1)
End If
End If
End Sub

'ページ p から再帰的に木をたどり削除
Sub removesub(p As *page)
Dim k As Integer
Dim q As *page

If p = NULL Then Exit Sub ' 見つからなかった
k = 0
While k < p->n And p->key[k] < key
k = k + 1
Wend
If k < p->n And p->key[k] = key Then ' 見つかった
deleted = TRUE
q = p->branch[k + 1]
If q <> NULL Then
While q->branch[0] <> NULL
q = q->branch[0]
Wend
p->key[k] = q->key[0]
key = q->key[0]
removesub(p->branch[k + 1])
If undersize Then restore(p, k + 1)
Else
removeitem(p, k)
End If
Else
removesub(p->branch[k])
if undersize Then restore(p, k)
End If
End Sub

'キー key をB木から外す
Sub remove()
Dim p As *page

deleted = FALSE
undersize = FALSE
removesub(root) ' 根から再帰的に木をたどり削除する
If deleted Then
If root->n = 0 Then ' 根が空になった場合
p = root
root = root->branch[0]
free(p)
End If
message = "削除しました"
Else
message = "見つかりません"
End If
End Sub

'デモ用にB木を表示
Sub printtree(p As *page)
Dim depth = 0 As Integer
Dim k As Integer

If p = NULL Then
Print ".";
Exit Sub
End If
Print "(";
depth = depth + 1
For k = 0 To p->n - 1
printtree(p->branch[k]) ' 再帰呼出し
Print p->key[k];
Next k
printtree(p->branch[p->n]) ' 再帰呼出し
Print ")";
depth = depth - 1
End Sub

'
Dim s As String
While 1
Input "Comand(挿入 I, 検索 S, 削除 R), key(n:整数) "; s, key
Select Case s
Case "i" Or "I"
insert()
Case "s" Or "S"
search()
Case "r" Or "R"
remove()
Case Else
message = "???"
End Select
Print message
printtree(root)
Print
Wend