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


Класс BinTree - часть 2


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




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