2分探索木 - abwiki @ ウィキ (ActiveBasic非公式wiki)

探索に用いる2分木

各ノードにデータと2個のポインタを持ち、ポインタleftでつながる子孫のデータは自分より小さく、ポインタrightでつながる子孫のデータは自分より大きい。

データの検索は根（ルート）より始め、そのデータより小さいないし大きい場合にポインタleftないしrightをたどる。左右の釣り合いの取れた2分木の場合、N個のデータから検索する時間は O(log2(N)) 程度であるが、最悪の場合は O(N) 程度まで低下する。
'原著ではノードの削除関数はdelete()関数ですが、予約語のためremove()としました

#N88BASIC
TypeDef keytype = Byte ' 探索のキーの型
Type node ' 木のノード
left As *node ' 左側へのポインタ
right As *node ' 右側へのポインタ
key[20] As keytype ' 探索キー(20文字)
End Type
Dim nil As node ' 末端用ノードnilの作成
Dim root As *node ' ルートノードの作成
root = VarPtr(nil) ' 初期値は当然nil

Function insert(key As *keytype) As *node ' 挿入（登録）
Dim cmp As Integer
Dim p As *node, pp As DWord, q As *node

' 検索
lstrcpy(nil.key, key) ' 番人
pp = VarPtr(root) ' rootから検索
p = root
cmp = lstrcmp(key, p->key)
While cmp <> 0
If cmp < 0 Then
pp = VarPtr(p->left)
p = p->left
Else
pp = VarPtr(p->right)
p = p->right
End If
cmp = lstrcmp(key, p->key)
Wend
' nilでなければ登録済み
If p <> VarPtr(nil) Then
insert = NULL
Exit Function
End If
' 新しいノードの作成
q = malloc(SizeOf(node))
If q = NULL Then
Print "メモリ不足"
insert = NULL
Exit Function
End If
lstrcpy(q->key, key)
q->left = VarPtr(nil)
q->right = p
' 登録
SetDWord(pp, q)
insert = q
End Function

Function remove(key As *keytype) As Integer ' 削除できれば 0, 失敗なら 1 を返す
Dim cmp As Integer
Dim p As *node, pp As DWord, q As *node, qq As DWord, r As *node, s As *node

' 検索
lstrcpy(nil.key, key) ' 番人
pp = VarPtr(root) ' rootから検索
p = root
cmp = lstrcmp(key, p->key)
While cmp <> 0
If cmp < 0 Then
pp = VarPtr(p->left)
p = p->left
Else
pp = VarPtr(p->right)
p = p->right
End If
cmp = lstrcmp(key, p->key)
Wend
' 見つからない
If p = VarPtr(nil) Then
remove = 1
Exit Function
End If
' 見つかった
r = p
If r->right = VarPtr(nil) Then ' 子が左のみの場合
SetDWord(pp, r->left)
ElseIf r->left = VarPtr(nil) Then ' 子が右のみの場合
SetDWord(pp, r->right)
Else ' 両方に子がある場合
' 削除する節より小さくかつ最大の葉を捜す(削除する節の変わりに入れる節を探す)
qq = VarPtr(r->left)
q = r->left
While q->right <> VarPtr(nil)
qq = VarPtr(q->right)
q = q->right
Wend
s = q ' 新しい節
SetDWord(qq, s->left) ' 新しい節の元あった場所にs->leftを詰める
s->left = r->left ' 新しい節に左の木を付ける
s->right = r->right ' 新しい節に右の木を付ける
SetDWord(pp, s) ' 新しい節を付ける
End If
free(r)
remove = 0 ' 削除成功
End Function

Function search(key As *keytype) As *node
Dim cmp As Integer
Dim p As *node

'検索
lstrcpy(nil.key, key) ' 番人
p = root ' rootから検索
cmp = lstrcmp(key, VarPtr(p->key))
While cmp <> 0
If cmp < 0 Then
p = p->left
Else
p = p->right
End If
cmp = lstrcmp(key, VarPtr(p->key))
Wend

If p <> VarPtr(nil) Then ' 見つかった
search = p
Else ' 見つからない
search = NULL
End If
End Function

Dim depth As Integer ' 木構造の深さ
Sub printtree(p As *node)
If p = VarPtr(root) Then depth = 0
If p->left <> VarPtr(nil) Then
depth = depth + 1
printtree(p->left)
depth = depth - 1
End If
Print Space$(5 * depth) + MakeStr(p->key)
If p->right <> VarPtr(nil) Then
depth = depth + 1
printtree(p->right)
depth = depth - 1
End If
End Sub

'
Dim s As String, buf[20] As Byte, str As String
While 1
Input "Comand(挿入 I, 削除 R, 検索 S), 文字列 "; s, str
ZeroMemory(buf, 21)
lstrcpy(buf, Left$(str, 20))
Select Case s
Case "i" Or "I"
If insert(buf) Then
Print "登録しました"
Else
Print "登録ずみです"
End If
Case "r" Or "R"
If remove(buf) Then
Print "登録されていません"
Else
Print "削除しました"
End If
Case "s" Or "S"
If search(buf) Then
Print "登録されています"
Else
Print "登録されていません"
End If
Case Else
Print "使えるのは I, R, S です"
End Select
If root <> VarPtr(nil) Then printtree(root)
Print
Wend