2分探索木の改良版

2分探索木では,ノードが n個あればポインタは 2*n個あるが,そのうち実際に子を指すポインタは n-1個しかない。そのため、残りは終端を表す値を入れておくのが普通であるが、その残りの n+1個のポインタを次のようにうまく使うのが,ひも付き2分木である。

あるノードの次に大きいキーを持つノードを指すのに空いているポインタを利用する。 下のプログラムで,各ノード中の flags は,左右のポインタが実際にそのノードの子を 指すかどうかを表すフラグである。 flags & RBIT が0であれば右ポインタはひもであり,そうでなければ右ポインタは実際の 子を指す。 flags & LBIT も同様である。

2分探索木のように再起呼び出しを利用して探索を行う場合、木のバランスが悪いと再起が深くなりすぎる。ひも付き2分木であれば再起呼び出しを使わなくてもよく、しかも任意のノードから昇順・降順でたどることもできる。

#N88BASIC

TypeDef keytype = Byte ' 探索のキーの型
Type node ' 木のノード
left As *node ' 左の子へのポインタ
right As *node ' 右の子へのポインタ
count As Byte ' 参照回数カウンタ
key[20] As keytype ' 探索のキー(登録文字列,20文字)
flags As Char ' 本文参照
End Type

Const LBIT = 1 ' flagsの説明参照
Const RBIT = 2 ' flagsの説明参照

Dim root As node ' ルートノードの作成 & 初期化
root.left = VarPtr(root)
root.right = VarPtr(root)
root.count = 0
ZeroMemory(root.key, 21)
root.flags = 0

Function newnode(key As *keytype) As *node ' 新しいノードを生成
Dim p As *node

p = malloc(SizeOf(node))
If p = 0 Then
Print "メモリ不足"
Exit Function
End If
lstrcpy(p->key, key) ' キーをコピーする
p->count = 1 ' 参照回数を1にする
newnode = p
End Function

Sub insertright(p As *node, key As *keytype) ' ノード p の右に挿入
Dim q As *node

q = newnode(key)
q->right = p->right ' 新しいノードを生成
q->left = p ' 左の子はじつは親を指すひも
q->flags = p->flags And RBIT ' 右フラグは親の右フラグを受け継ぐ
p->flags = p->flags Or RBIT ' q はひもでないので親の右フラグを立てる
p->right = q ' q を親 p の右の子にする
End Sub

Sub insertleft(p As *node, key As *keytype) ' ノード p の左に挿入
Dim q As *node ' 説明は上と同様なので省く

q = newnode(key)
q->left = p->left
q->right = p
q->flags = p->flags And LBIT
p->flags = p->flags Or LBIT
p->left = q
End Sub

Sub insert(key As *keytype) ' 挿入(登録)
Dim cmp As Integer ' 比較結果
Dim p As *node

p = VarPtr(root)
cmp = 1 ' 最初の子は親の右に
Do
If cmp < 0 Then ' 小さければ左に登録
If p->flags And LBIT Then
p = p->left
Else
insertleft(p, key)
Exit Sub
End If
Else ' 大きければ右に登録
If p->flags And RBIT Then
p = p->right
Else
insertright(p, key)
Exit Sub
End If
End If
cmp = lstrcmp(key, p->key)
Loop While cmp <> 0
p->count = p->count + 1 ' 等しければ参照回数を増すだけ
End Sub

Function successor(p As *node) As *node ' 昇順で p の直後のノード
Dim q As *node

q = p->right
If p->flags And RBIT Then
While q->flags And LBIT
q = q->left
Wend
End If
successor = q
End Function

Sub printnorder() ' 昇順で全キーを出力
Dim p As *node

p = VarPtr(root)
p = successor(p)
While p <> VarPtr(root)
Print MakeStr(p->key), p->count
p = successor(p)
Wend
End Sub

'テストプログラム
Dim str As String, word[20] As keytype

While 1
Input str ' 単語を読み登録
ZeroMemory(word, 20)
lstrcpy(word, str)
insert(word)
printnorder()
Wend