Основы офисного программирования и язык VBA


Пример 9.4


Option Explicit

'Класс BinTree 'Бинарным будем называть дерево, у которого каждая вершина имеет 'одного или двух потомков, называемых левым и правым сыном (поддеревом). 'В дальнейшем будем полагать, что узел нашего дерева содержит 'информационное поле info и поле ключа - key. 'Деревом поиска (двоичным или лексикографическим деревом) будем называть 'бинарное дерево, в котором ключ каждой вершины больше ключа, хранящегося 'в корне левого поддерева, и меньше ключа, хранящегося в корне правого поддерева. 'Рассмотрим операции над деревом поиска: поиск, включение, удаление элементов 'и обход дерева. Все операции сохраняют структуру дерева поиска.

Public root As TreeNode

Public Sub PrefixOrder() 'Префиксный обход дерева (корень, левое поддерево, правое)

If Not (root Is Nothing) Then With root Debug.Print "key: ",.key, "info: ",.info .left.PrefixOrder .right.PrefixOrder End With End If

End Sub

Public Sub InfixOrder() 'Инфиксный обход дерева (левое поддерево, корень, правое)

If Not (root Is Nothing) Then With root .left.InfixOrder Debug.Print "key: ",.key, "info: ",.info .right.InfixOrder End With End If

End Sub

Public Sub PostfixOrder() 'Постфиксный обход дерева (левое поддерево, правое, корень)

If Not (root Is Nothing) Then With root .left.PostfixOrder .right.PostfixOrder Debug.Print "key: ",.key, "info: ",.info End With End If

End Sub

Public Sub SearchAndInsert(key As String, info As String) 'Если в дереве есть узел с ключом key, 'то возвращается информация в этом узле - работает поиск 'Если такого узла нет, то создается новый узел и его поля 'заполняются информацией, - работает вставка. 'Вначале поиск If root Is Nothing Then ' элемент не найден и происходит вставка Set root = New TreeNode root.key = key: root.info = info ElseIf key < root.key Then 'Поиск в левом поддереве root.left.SearchAndInsert key, info ElseIf key > root.key Then 'Поиск в правом поддереве root.right.SearchAndInsert key, info Else 'Элемент найден - возвращается результат поиска info = root.info End If

End Sub

Public Sub DelInTree(key As String) 'Эта процедура позволяет удалить элемент дерева с заданным ключом 'Удаление с сохранением структуры дерева более сложная операция, 'чем вставка или поиск. Причина сложности в том, что при удалении 'элемента остаются два его потомка, которые необходимо корректно 'связать с оставшимися элементами, чтобы не нарушить структуру дерева поиска. 'В программе анализируются три случая: 'Удаляется лист дерева (нет потомков - нет проблем), 'Удаляется узел с одним потомком (потомок замещает удаленный узел), 'Есть два потомка. В этом случае узел может быть заменен одним из двух 'возможных кандидатов, не имеющих двух потомков. 'Кандидатами являются самый левый узел правого подддерева и 'самый правый узел левого поддерева. 'Мы производим удаление в левом поддереве.

Dim q As TreeNode If root Is Nothing Then Debug.Print "Key is not found" ElseIf key < root.key Then 'Удаляем из левого поддерева root.left.DelInTree key ElseIf key > root.key Then 'Удаляем из правого поддерева root.right.DelInTree key Else 'Удаление узла Set q = root If q.right.root Is Nothing Then Set root = q.left.root ElseIf q.left.root Is Nothing Then Set root = q.right.root Else 'есть два потомка q.left.ReplaceAndDelete q End If Set q = Nothing End If

End Sub

Public Sub ReplaceAndDelete(q As TreeNode) 'Заменяет узел на самый правый If Not (root.right.root Is Nothing) Then root.right.ReplaceAndDelete q Else 'Найден самый правый q.key = root.key: q.info = root.info Set root = root.left.root End If

End Sub

Пример 9.4.

Закрыть окно






Начало  Назад  Вперед