Автоматизация операций над красно-чёрными деревьями
Для работы с двоичными деревьями важно уметь выполнять следующие операции:
- поиск по дереву;
- включение узла в дерево;
- удаление узла из дерева.
Именно эти операции будут представлены в программе.
Основной задачей является программирование операций над красно-чёрными деревьями, соблюдая их основные свойства. Поэтому целесообразнее использовать объектно-ориентированное программирование.
Так же программа требует использования модуля CRT, который содержит библиотеку процедур, которые работают с клавиатурой и дисплеем.
В основе объектно-ориентированного программирования лежит идея объединения в одной структуре данных и действий, которые производятся над этими данными [4].
Программа начинается с описания переменных и модулей, которые в ней используются.
uses crt;
type
string_20 = string[20]; { Это - тип данных, хранимых в КЧД }
PTreeNode = ^TreeNode; { Узел дерева }
TreeNode = object
public
constructor init(_s: string; _parent: PTreeNode);
public
Color: integer; { Цвет листа: 0 = Черный, 1 = Красный }
left,right,parent,duplicates: PTreeNode; { Список дубликатов }
data_string: string_20;
deleted: boolean; { Флаг для "ленивого" удаления }
end;
RBTree = object
public
constructor init;
destructor done;
function Search(s: string): integer;
{ Возвращает +1, если строка присутствует в дереве, и -1 если ее там нет }
function SearchFirstMatch(s: string): PTreeNode;
{ Работает точно так же, как и Search, но возвращает указатель
типа PTreeNode на первый подходящий элемент }
procedure Insert(s: string);
{ Добавляет новый элемент в дерево }
|
|
|
function InsertItem(s: string; node: PTreeNode): PTreeNode;
function Remove(s: string): boolean; { Удаляет заданную строку }
procedure SaveToFile(var f: text); { Сохраняет дерево в текстовый файл }
function LeftDepth: integer; { Находит глубину левого поддерева }
function RightDepth: integer; { Находит глубину правого поддерева }
function NumberOfLeaves(p: PTreeNode): integer;{ Находит число листьев в дереве }
public
root: PTreeNode;
private
procedure LeftRotation(node: PTreeNode);
procedure RightRotation(node: PTreeNode);
{ "Ротации" (повороты), используемые при вставке для балансировки дерева}
function TreeDepth(p: PTreeNode): integer;
{ Рекурсивная функция для нахождения глубины дерева, с корнем в P }
procedure DeleteTree(p: PTreeNode);
{ Деструктор вызывает эту процедуру для удаления дерева }
procedure SaveNode(level: integer;
const node: PTreeNode; var f: text);
end;
Const { Цвета для узлов }
node_Red = 1;
node_Black = 0;
Объектно-ориентированное программирование предполагает образование нового типа данных – объект. Объект – это такая структура, компонентами которой являются взаимосвязанные данные различных типов и использующие эти данные процедуры и функции. Компоненты-данные называются полями объекта, а компоненты-процедуры и функции называются методами. Для обозначения типа «объект» в языке имеется служебное слово OBJECT. Каждая переменная типа «объект», содержащая виртуальные методы, должна инициализироваться отдельным вызовом конструктора. CONSTRUCTOR – конструктор, который выполняет установочную работу для механизма виртуальных методов [4].
|
|
|
Так же используется деструктор. DESTRUCTOR – специальный метод для освобождения динамических полей данных объекта, под которые выделялась дополнительная память при выполнении конструктора или иной процедуры инициализации, до уничтожения самого объекта.
После объявления переменных описываются все перечисленные процедуры и функции. Большая часть процедур и функций используется для того, чтобы построить красно-чёрное дерево в соответствии со всеми его основными свойствами [4].
constructor TreeNode.init(_s: string; _parent: PTreeNode);
begin
data_string := _s;
left := nil; right := nil;
parent := _parent; { Указатель на предка }
Duplicates := nil; { Изначально у узла нет дубликатов }
Color := node_Red; { Новые узлы становятся "Красными" }
Deleted := False; { Этот узел не удален }
end;
{Функция сравнения строк (ведомые пробелы не принимаются во внимание)}
function compare(s1, s2: string): integer;
procedure trim(var s: string);
begin
while s[length(s)] = ' ' do delete(s, length(s), 1);
end;
begin
trim(s1); trim(s2);
if s1 < s2 then compare := -1
else if s1 > s2 then compare := +1
|
|
|
else compare := 0;
end;
constructor RBTree.init;
begin
root := nil;
end;
destructor RBTree.done;
begin
DeleteTree(Root); { DeleteTree освобождает динамическую память }
end;
procedure RBTree.DeleteTree(p: PTreeNode);
begin
if p <> nil then begin
DeleteTree(p^.Left); { Удалить левое поддерево }
DeleteTree(p^.Right); { Удалить правое поддерево }
DeleteTree(p^.Duplicates);
dispose(p);
end;
p := nil; { Узел более не используется }
end;
{ При вставке элемента могут произойти 3 случая:
1. Новый узел и его "дядя" - "Красные"
2. Новый узел красный, "дядя" - "Черный", и узел - левый потомок
3. Новый узел красный, "дядя" - "Черный", и узел - правый потомок }
procedure RBTree.Insert(s: string);{ Создает новый узел для хранения строки }
var
node, node_2: PTreeNode;
begin
node := InsertItem(s, root); { Вставить строку в дерево }
if node = nil then exit; { Изменять дерево не нужно }
while(node <> root) and (node^.parent^.color = node_Red) do begin
{ Проверяем, находится ли узел в левом поддереве }
if node^.parent = node^.parent^.parent^.left then begin
node_2 := node^.parent^.parent^.right; { Делаем node2 "дядей" нашего узла }
{ Если "дядя" красного цвета - это случай 1 }
if (node_2 <> nil) and (node_2^.Color = node_Red) then begin
node^.parent^.Color := node_Black; { Изменяем цвет "родителя" на черный }
node_2^.Color := node_Black; { Изменяем цвет "дяди" на черный }
|
|
|
node^.Parent^.Parent^.Color := node_Red; { Делаем "дедушку" красным }
node := node^.Parent^.Parent; { Двигаемся к вершине дерева для проведения дополнительных исправлений }
end
else begin { "дядя" - черного цвета, случай 2 или 3 }
if Node = Node^.Parent^.Right then begin { Проверяем на случай №3 }
Node := Node^.Parent; { Узел - правый потомок, это как раз случай №3 }
LeftRotation(Node); { ... который требует левую "ротацию" }
end;
Node^.Parent^.Color := node_Black; { Установка для случаев №2... }
Node^.Parent^.Parent^.Color := node_Red; { ... и №3 }
RightRotation(Node^.Parent^.Parent);
end;
end
else begin { узел - в правом поддереве }
node_2 := Node^.Parent^.Parent^.Left; { Делаем node2 "дядей" нашего узла }
{ Если "дядя" красного цвета - это случай 1 }
if(node_2 <> nil) and (node_2^.Color = node_Red) then begin
Node^.Parent^.Color := node_Black; { Изменяем цвет "родителя" на черный }
Node_2^.Color := node_Black; { Изменяем цвет "дяди" на черный }
Node^.Parent^.Parent^.Color := node_Red; { Делаем "дедушку" красным }
Node := Node^.Parent^.Parent; { Двигаемся к вершине дерева... }
end
else begin { "дядя" - "черный", случай №2 или №3 }
{ Проверяем на случай №3 ("лево" и "право" обменяны местами) }
if Node = Node^.Parent^.Left then begin
Node := Node^.Parent; { Узел - левый потомок, это как раз случай №3...}
RightRotation(Node); { ... который требует правую "ротацию" }
end;
Node^.Parent^.Color := node_Black; { Установка для случаев №2... }
Node^.Parent^.Parent^.Color := node_Red; { ... и №3 }
LeftRotation(Node^.Parent^.Parent);
end;
end
end;
{ По правилу КЧД корень дерева должен быть черным }
Root^.Color := node_Black;
end;
function RBTree.InsertItem(s: string; node: PTreeNode): PTreeNode;
var
comparison: integer;
GreaterThanLeft, LessThanRight: boolean;
T: PTreeNode;
begin
if root = nil then begin
root := new(PTreeNode, init(s, nil)); { устанавливаем корень }
{ По правилу КЧД корень дерева должен быть черным }
root^.Color := node_Black;
InsertItem := root; exit
end;
while True do begin
comparison := compare(s, node^.data_string);
if node^.Deleted then begin
{ Для начала проверим, является ли узел "удаленным".
Если это так, то существует возможность использовать "удаленный" узел для хранения новой записи, если она должна будет находиться между двумя "потомками" }
if comparison=0 then begin
node^.Deleted := false; { удел больше "удаленным" не считать }
InsertItem := nil; exit
end;
if node^.Left = nil then GreaterThanLeft := true
else
{(В случае, если compare() < 0): строка не больше чем левый потомок, поэтому "удаленный" узел не может использоваться для хранения новой записи}
GreaterThanLeft := (compare(s, node^.left^.data_string) > 0);
if node^.Right = nil then LessThanRight := true
else
{ (В случае, если compare() < 0): строка не больше чем правый потомок,
поэтому "удаленный" узел не может использоваться для хранения новой записи }
{??er??}
LessThanRight := (compare(s, node^.right^.data_string) > 0);
if GreaterThanLeft and LessThanRight then begin
{ "удаленный" узел может использоваться для хранения новой записи }
node^.data_string := s;
node^.Deleted := false; { удел больше "удаленным" не считать }
InsertItem := nil; exit
{ возвращаем NIL, чтобы избежать "ротаций" дерева, т.к. элемент, значение которого было изменено, находится на своем месте }
end;
end;
{ if comparison == 0 then begin
end }
if comparison < 0 then begin
{ Если Left пусто, помещаем новый узел туда }
if Node^.Left = nil then begin
Node^.Left := new(PTreeNode, init(s, Node)); { Добавляем новый узел ... }
InsertItem := Node^.Left; { ... как левого потомка }
exit
end
else Node := Node^.Left; { Проверить левое поддерево }
end
else
if comparison > 0 then begin
{ Если Right пусто, помещаем новый узел туда }
if Node^.Right = nil then begin
Node^.Right := new(PTreeNode, init(s, Node)); { Добавляем новый узел .}
InsertItem := Node^.Right; { ... как правого потомка }
exit
end
else Node := Node^.Right; { Проверить правое поддерево }
end
else
if Node^.Deleted = false then
begin { узел - дубликат }
Sound(220); { Beep }
Delay(1200); { For 200 ms }
NoSound; { Relief! }
writeln('!!!!!! Такой узел уже есть !!!!!!!');
T := node;
{ находим конец списка дубликатов }
while(T^.Duplicates <> nil) do T := T^.Duplicates;
T^.Duplicates := new(PTreeNode, init(s, T));
InsertItem := nil; exit
{
возвращаем NIL, чтобы избежать "ротаций" дерева, т.к.
мы просто изменили список дубликатов
}
end
{ else
Node^.Deleted:=false;}
end;
end;
function RBTree.Remove(s: string): boolean;
var T, prev_node, node: PTreeNode;
begin
Remove := False;
Node := SearchFirstMatch(s); { Найдем подходящий узел в дереве }
if node = nil then exit; { Строка не была найдена - выход }
if node^.Duplicates <> nil then begin
{ если есть дубликаты - то один из дубликатов может занять место удаляемой записи }
T := node;
while T^.Duplicates <> nil do begin
prev_node := T;
T := T^.Duplicates;
end;
node^.data_string := T^.data_string;
{ Копируем содержимое последнего дубликата в ту запись, которую будем удалять }
dispose(T);
prev_node^.Duplicates := nil;
{ "отсекаем" последний элемент списка дубликатов }
Remove := true; { удаление было успешным }
end
else
Node^.Deleted := true; { Помечаем узел как "удаленный" для "ленивого" удаления }
Remove := True
end;
function RBTree.Search(s: string): integer;
var
node: PTreeNode;
comparison: integer;
begin
Search := -1;
node := root;
while Node <> nil do begin
comparison := compare(s, node^.data_string);
if comparison < 0 then Node := Node^.Left {просматриваем левое поддерево}
else
{ if comparison < 0 then Node := Node^.Right ??err?? возможна ошибка }
if comparison > 0 then Node := Node^.Right { просматриваем правое поддерево }
else
if Node^.Deleted then exit
{ если узел помечен на удаление - то не принимать его во внимание, выход }
else begin
{ Строка найдена }
search := 1; exit
end;
end;
{ Запись не найдена }
end;
function RBTree.SearchFirstMatch(s: string): PTreeNode;
{ Возвращает указатель на первый узел, хранящий заданную строку }
var
node: PTreeNode;
comparison: integer;
begin
SearchFirstMatch := nil;
node := root;
while Node <> nil do begin
comparison := compare(s, node^.data_string);
if comparison < 0 then Node := Node^.Left {просматриваем левое поддерево}
else
if comparison > 0 then Node := Node^.Right { просматриваем правое поддерево }
else
if Node^.Deleted then exit
{ если узел помечен на удаление - то не принимать его во внимание, выход }
else begin
{ Строка найдена }
SearchFirstMatch := node; exit
end;
end;
end;
procedure RBTree.SaveToFile(var f: text);
{ сохраняет узлы в Прямом (нисходящем) порядке }
begin
{ Вызываем рекурсию }
SaveNode(0, root, f);
end;
procedure RBTree.SaveNode(level: integer;
const node: PTreeNode; var f: text);
const
_color: array[0 .. 1] of char = ('B', 'R');
begin
if node <> nil then begin
{ if not node^.Deleted then begin }
if _color[node^.Color]='B' then TextColor(BLACK)
else TextColor(RED);
if node^.Deleted then TextBackground(BLUE);
write(f, '':3*level,
{ node^.data_string + ' ('+_color[node^.Color]+')'); }
node^.data_string );
TextBackground(WHITE);
TextColor(GREEN);
writeln(f,'');
{ end; }
SaveNode(level + 1, node^.Left, f); { Сохраним узлы левого поддерева }
SaveNode(level + 1, node^.Right, f); { Сохраним узлы правого поддерева }
end;
end;
function RBTree.LeftDepth: integer;
begin
LeftDepth := TreeDepth(Root^.Left); { Измеряем левое поддерево }
end;
function RBTree.RightDepth: integer;
begin
RightDepth := TreeDepth(Root^.Right); { Измеряем правое поддерево }
end;
function RBTree.TreeDepth(p: PTreeNode): integer;
var _left, _right: integer;
begin
_left := 0; _right := 0;
if p^.Left <> nil then
_left := TreeDepth(p^.Left); { Взять глубину левого поддерева }
if p^.Right <> nil then
_right := TreeDepth(p^.Right); { Взять глубину правого поддерева }
if _left > _right then { проверяем, какое поддерево "глубже" }
TreeDepth := _left + 1 { вернем глубину левого поддерева + 1 }
else
TreeDepth := _right + 1; { вернем глубину правого поддерева + 1 }
end;
function RBTree.NumberOfLeaves(p: PTreeNode): integer;
var total: integer;
begin
NumberOfLeaves := 1;
total := 0;
if (p^.Left = nil) and (p^.Right = nil) then exit; { узел является "листом" }
{ считаем число листьев в левом поддереве }
if p^.Left <> nil then inc(total, NumberOfLeaves(p^.Left));
{ считаем число листьев в правом поддереве }
if p^.Right <> nil then inc(total, NumberOfLeaves(p^.Right));
NumberOfLeaves := total;
{ и возвращаем общее количество листьев в дереве }
end;
procedure RBTree.LeftRotation(node: PTreeNode);
var Right: PTreeNode;
begin
Right := node^.Right; { hold node's right child }
{ make the node's right child its right child's left child }
node^.Right := Right^.Left;
if Right^.Left <> nil then
Right^.Left^.Parent := Node; { point the child to its new parent }
if Right <> nil then
Right^.Parent := Node^.Parent; { point the child to its new parent }
if Node^.Parent <> nil then begin { if node is not the root }
if Node = Node^.Parent^.Left then { if node is a left child }
Node^.Parent^.Left := Right { make node's right child its parent's left child }
else
Node^.Parent^.Right := Right; {make node's right child its parent's right child }
end
else
Root := Right; { node's right child is now the root }
Right^.Left := Node; { node becomes its right child's left child }
if Node <> nil then
Node^.Parent := Right; { point node to its new parent }
end;
procedure RBTree.RightRotation(node: PTreeNode);
var Left: PTreeNode;
begin
Left := node^.Left; { hold node's left child }
{ make the node's left child its left child's right child }
Node^.Left := Left^.Right;
if Left^.Right <> nil then
Left^.Right^.Parent := Node; { point the child to its new parent }
if Left <> nil then
Left^.Parent := Node^.Parent; { point the child to its new parent }
if Node^.Parent <> nil then begin { if node is not the root }
if Node = Node^.Parent^.Right then { if node is a right child }
Node^.Parent^.Right := Left { make node's left child its parent's right child }
else
Node^.Parent^.Left := Left; { make node's left child its parent's left child }
end
else
Root := Left; { node's left child is now the root }
Left^.Right := Node; { node becomes its left child's right child }
if Node <> nil then
Node^.Parent := Left; { point node to its new parent }
end;
Далее следует собственно, программа, иллюстрирующая использование КЧД.
var
console: text;
s: string_20;
tree: RBTree;
begin
assigncrt(console);
rewrite(console);
TextBackground(WHITE);
TextColor(GREEN);
tree.init;
repeat
writeln('1 – Построение дерева');
writeln('2 - Поиск');
writeln('3 – Показ дерева');
writeln('4 – Удаление узла');
writeln('9 - Выход');
readln(s);
if ( s='1') then begin
repeat
write('enter string (20 chars max): '); readln(s);
if s <> '' then begin
tree.insert(s);
Writeln('__________________________________________');
tree.SaveToFile(console); { Выводим дерево на консоль }
writeln('__________________________________________');
end;
until s = '';
end;
if ( s='3') then begin
Writeln('**');
tree.SaveToFile(console);
Writeln('**');
end;
if ( s='4') then begin
write('enter string (20 chars max): '); readln(s);
Write('узел ');Write(s);
if tree.search(s)=1 then begin
tree.Remove(s);
writeln('удалён');
tree.SaveToFile(console);
end
else writeln('не найден');
Writeln('**');
end;
if ( s='2') then begin
write('enter string (20 chars max): '); readln(s);
Write('узел');Write(s);
if tree.search(s)=1 then writeln('найден')
else writeln('не найден');
Writeln('**');
end;
until s = '9';
tree.SaveToFile(console);
{ Проверяем работу Search }
if tree.search('four') = 1 then writeln('found')
else writeln('not found');
{ Проверяем работу Remove }
tree.Remove('four');
tree.SaveToFile(console);
tree.done;
close(console);
end.
Заключение
В процессе выполнения работы были решены следующие задачи:
· ра ссмотрены красно-чёрные деревья и их свойства;
· изучены основные операции над красно-чёрными деревьями;
· представлена реализация основных операций над красно-чёрными деревьями на алгоритмическом языке;
· проиллюстрированы примеры красно-чёрных деревьев, а так же операции над ними;
· произведена автоматизация основных операций над красно-чёрными деревьями.
В заключение курсовой работы можно сделать вывод, что красно-чёрные деревья это наиболее оптимальный способ представления структур данных, обеспечивающий быстрый поиск нужной информации. Автоматизация основных операций над красно-чёрными деревьями с использованием объектно-ориентированного программирования позволяет упросить работу с деревьями и даёт возможность расширять область применения, не переделывая программу, а лишь добавляя в неё новые уровни иерархии.
Красно-чёрные деревья составляют неотъемлемую часть современного информационного пространства, а также имеют широкую сферу применения. Поэтому изучение красно-чёрных деревьев, их основных свойств и операций над ними помогает изучить сферу их использования.
список литературы:
1. АЛГОРИТМЫ МЕТОДЫ ИСХОДНИКИ[электронный ресурс]. – Режим доступа: http://algolist.manual.ru/ds/rbtree.php.
2. Кнут Д.Э. Искусство программирования. Том 2. Получисленные алгоритмы: Пер. с англ. - М.: «Вильямс», 2000. — 682с.
3. Кормен, Томас X., Лейзерсон, Чарльз И., Ривест, Рональд Л., Штайн, Клиффорд. Алгоритмы: построение и анализ, 2-е издание. : Пер. с англ. - М.: Издательский дом "Вильяме", 2005. - 1296 с.: ил. - Парал. тит. англ.
4. Поляков Д.Б., Круглов И.Ю.. Программирование в среде Турбо Паскаль (версия 5.5): Справ.-метод. пособие. – М.: Изд-во МАИ, 1992. – 576 с.
5. [электронный ресурс]. – Режим доступа: http://mathc.chat.ru/a3/articl03.htm.
6. Pascal Page[электронный ресурс]. – Режим доступа: http://volvo71.narod.ru/faq_folder/rb_tree.htm.
Приложение 1. Листинг программы
Program rbtree_k;
uses crt;
type
string_20 = string[20];
PTreeNode = ^TreeNode;
TreeNode = object
public
constructor init(_s: string; _parent: PTreeNode);
public
Color: integer;
left,right,parent,duplicates: PTreeNode;
data_string: string_20;
deleted: boolean;
end;
RBTree = object
public
constructor init;
destructor done;
function Search(s: string): integer;
function SearchFirstMatch(s: string): PTreeNode;
procedure Insert(s: string);
function InsertItem(s: string; node: PTreeNode): PTreeNode;
function Remove(s: string): boolean;
procedure SaveToFile(var f: text);
function LeftDepth: integer;
function RightDepth: integer;
function NumberOfLeaves(p: PTreeNode): integer;
public
root: PTreeNode;
private
procedure LeftRotation(node: PTreeNode);
procedure RightRotation(node: PTreeNode);
function TreeDepth(p: PTreeNode): integer;
procedure DeleteTree(p: PTreeNode);
procedure SaveNode(level: integer;
const node: PTreeNode; var f: text);
end;
Const
node_Red = 1;
node_Black = 0;
constructor TreeNode.init(_s: string; _parent: PTreeNode);
begin
data_string := _s;
left := nil; right := nil;
parent := _parent;
Duplicates := nil;
Color := node_Red;
Deleted := False;
end;
function compare(s1, s2: string): integer;
procedure trim(var s: string);
begin
while s[length(s)] = ' ' do delete(s, length(s), 1);
end;
begin
trim(s1); trim(s2);
if s1 < s2 then compare := -1
else if s1 > s2 then compare := +1
else compare := 0;
end;
constructor RBTree.init;
begin
root := nil;
end;
destructor RBTree.done;
begin
DeleteTree(Root);
end;
procedure RBTree.DeleteTree(p: PTreeNode);
begin
if p <> nil then begin
DeleteTree(p^.Left);
DeleteTree(p^.Right);
DeleteTree(p^.Duplicates);
dispose(p);
end;
p := nil;
end;
procedure RBTree.Insert(s: string);
var
node, node_2: PTreeNode;
begin
node := InsertItem(s, root);
if node = nil then exit;
while(node <> root) and (node^.parent^.color = node_Red) do begin
if node^.parent = node^.parent^.parent^.left then begin
node_2 := node^.parent^.parent^.right;
if (node_2 <> nil) and (node_2^.Color = node_Red) then begin
node^.parent^.Color := node_Black;
node_2^.Color := node_Black;
node^.Parent^.Parent^.Color := node_Red;
node := node^.Parent^.Parent;
end
else begin
if Node = Node^.Parent^.Right then begin
Node := Node^.Parent;
LeftRotation(Node);
end;
Node^.Parent^.Color := node_Black;
Node^.Parent^.Parent^.Color := node_Red;
RightRotation(Node^.Parent^.Parent);
end;
end
else begin
node_2 := Node^.Parent^.Parent^.Left;
if(node_2 <> nil) and (node_2^.Color = node_Red) then begin
Node^.Parent^.Color := node_Black;
Node_2^.Color := node_Black;
Node^.Parent^.Parent^.Color := node_Red;
Node := Node^.Parent^.Parent;
end
else begin
if Node = Node^.Parent^.Left then begin
Node := Node^.Parent;
RightRotation(Node);
end;
Node^.Parent^.Color := node_Black;
Node^.Parent^.Parent^.Color := node_Red;
LeftRotation(Node^.Parent^.Parent);
end;
end
end;
Root^.Color := node_Black;
end;
function RBTree.InsertItem(s: string; node: PTreeNode): PTreeNode;
var
comparison: integer;
GreaterThanLeft, LessThanRight: boolean;
T: PTreeNode;
begin
if root = nil then begin
root := new(PTreeNode, init(s, nil));
root^.Color := node_Black;
InsertItem := root; exit
end;
while True do begin
comparison := compare(s, node^.data_string);
if node^.Deleted then begin
if comparison=0 then begin
node^.Deleted := false;
InsertItem := nil; exit
end;
if node^.Left = nil then GreaterThanLeft := true
else GreaterThanLeft := (compare(s, node^.left^.data_string) > 0);
if node^.Right = nil then LessThanRight := true
else LessThanRight := (compare(s, node^.right^.data_string) > 0);
if GreaterThanLeft and LessThanRight then begin
node^.data_string := s;
node^.Deleted := false;
InsertItem := nil; exit
end;
end;
if comparison < 0 then begin
if Node^.Left = nil then begin
Node^.Left := new(PTreeNode, init(s, Node));
InsertItem := Node^.Left;
exit
end
else Node := Node^.Left;
end
else
if comparison > 0 then begin
if Node^.Right = nil then begin
Node^.Right := new(PTreeNode, init(s, Node));
InsertItem := Node^.Right;
exit
end
else Node := Node^.Right;
end
else
if Node^.Deleted = false then begin
Sound(220);
Delay(1200);
NoSound;
writeln('!!!!!! Такой узел уже есть !!!!!!!');
T := node;
while(T^.Duplicates <> nil) do T := T^.Duplicates;
T^.Duplicates := new(PTreeNode, init(s, T));
InsertItem := nil; exit
end
end;
end;
function RBTree.Remove(s: string): boolean;
var T, prev_node, node: PTreeNode;
begin
Remove := False;
Node := SearchFirstMatch(s);
if node = nil then exit;
if node^.Duplicates <> nil then begin
T := node;
while T^.Duplicates <> nil do begin
prev_node := T;
T := T^.Duplicates;
end;
node^.data_string := T^.data_string;
dispose(T);
prev_node^.Duplicates := nil;
Remove := true;
end
else
Node^.Deleted := true;
Remove := True
end;
function RBTree.Search(s: string): integer;
var
node: PTreeNode;
comparison: integer;
begin
Search := -1;
node := root;
while Node <> nil do begin
comparison := compare(s, node^.data_string);
if comparison < 0 then Node := Node^.Left
else if comparison > 0 then Node := Node^.Right
else if Node^.Deleted then exit
else begin
search := 1; exit
end;
end;
end;
function RBTree.SearchFirstMatch(s: string): PTreeNode;
var
node: PTreeNode;
comparison: integer;
begin
SearchFirstMatch := nil;
node := root;
while Node <> nil do begin
comparison := compare(s, node^.data_string);
if comparison < 0 then Node := Node^.Left
else if comparison > 0 then Node := Node^.Right
else if Node^.Deleted then exit
else begin
SearchFirstMatch := node; exit
end;
end;
end;
procedure RBTree.SaveToFile(var f: text);
begin
SaveNode(0, root, f);
end;
procedure RBTree.SaveNode(level: integer;
const node: PTreeNode; var f: text);
const
_color: array[0 .. 1] of char = ('B', 'R');
begin
if node <> nil then begin
if _color[node^.Color]='B' then TextColor(BLACK)
else TextColor(RED);
if node^.Deleted then TextBackground(BLUE);
write(f, '':3*level,node^.data_string );
TextBackground(WHITE);
TextColor(GREEN);
writeln(f,'');
SaveNode(level + 1, node^.Left, f);
SaveNode(level + 1, node^.Right, f);
end;
end;
function RBTree.LeftDepth: integer;
begin
LeftDepth := TreeDepth(Root^.Left);
end;
function RBTree.RightDepth: integer;
begin
RightDepth := TreeDepth(Root^.Right);}
end;
function RBTree.TreeDepth(p: PTreeNode): integer;
var _left, _right: integer;
begin
_left := 0; _right := 0;
if p^.Left <> nil then _left := TreeDepth(p^.Left);
if p^.Right <> nil then _right := TreeDepth(p^.Right);
if _left > _right then TreeDepth := _left + 1
else TreeDepth := _right + 1;
end;
function RBTree.NumberOfLeaves(p: PTreeNode): integer;
var total: integer;
begin
NumberOfLeaves := 1;
total := 0;
if (p^.Left = nil) and (p^.Right = nil) then exit;
if p^.Left <> nil then inc(total, NumberOfLeaves(p^.Left));
if p^.Right <> nil then inc(total, NumberOfLeaves(p^.Right));
NumberOfLeaves := total;
end;
procedure RBTree.LeftRotation(node: PTreeNode);
var Right: PTreeNode;
begin
Right := node^.Right;
node^.Right := Right^.Left;
if Right^.Left <> nil then
Right^.Left^.Parent := Node;
if Right <> nil then
Right^.Parent := Node^.Parent;
if Node^.Parent <> nil then begin
if Node = Node^.Parent^.Left then Node^.Parent^.Left := Right
else Node^.Parent^.Right := Right;
end
else Root := Right;
Right^.Left := Node;
if Node <> nil then Node^.Parent := Right;
end;
procedure RBTree.RightRotation(node: PTreeNode);
var Left: PTreeNode;
begin
Left := node^.Left;
Node^.Left := Left^.Right;
if Left^.Right <> nil then Left^.Right^.Parent := Node;
if Left <> nil then Left^.Parent := Node^.Parent;
if Node^.Parent <> nil then begin
if Node = Node^.Parent^.Right then Node^.Parent^.Right := Left
else Node^.Parent^.Left := Left;
end
else Root := Left;
Left^.Right := Node;
if Node <> nil then Node^.Parent := Left;
end;
var
console: text;
s: string_20;
tree: RBTree;
begin
assigncrt(console);
rewrite(console);
TextBackground(WHITE);
TextColor(GREEN);
tree.init;
repeat
writeln('1 – Построение дерева');
writeln('2 - Поиск');
writeln('3 – Показ дерева');
writeln('4 – Удаление узла');
writeln('9 - Выход');
readln(s);
if ( s='1') then begin
repeat
write('enter string (20 chars max): '); readln(s);
if s <> '' then begin
tree.insert(s);
Writeln('__________________________________________');
tree.SaveToFile(console); { Выводим дерево на консоль }
writeln('__________________________________________');
end;
until s = '';
end;
if ( s='3') then begin
Writeln('**');
tree.SaveToFile(console);
Writeln('**');
end;
if ( s='4') then begin
write('enter string (20 chars max): '); readln(s);
Write('node ');Write(s);
if tree.search(s)=1 then begin
tree.Remove(s);
writeln(' удалён');
tree.SaveToFile(console);
end
else writeln(' не найден');
Writeln('**');
end;
if ( s='2') then begin
write('enter string (20 chars max): '); readln(s);
Write('node ');Write(s);
if tree.search(s)=1 then writeln(' найден')
else writeln(' не найден');
Writeln('**');
end;
until s = '9';
tree.SaveToFile(console);
{ Проверяем работу Search }
if tree.search('four') = 1 then writeln('found')
else writeln('not found');
{ Проверяем работу Remove }
tree.Remove('four');
tree.SaveToFile(console);
tree.done;
close(console);
end.
Дата добавления: 2020-12-12; просмотров: 101; Мы поможем в написании вашей работы! |
Мы поможем в написании ваших работ!