「2分探索木」の編集履歴（バックアップ）一覧はこちら

「2分探索木」(2010/01/25 (月) 19:39:18) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

探索に用いる2分木 

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

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