Главная страница Случайная страница
КАТЕГОРИИ:
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника
Приложение А. type DataType = integer;
|
|
(обязательное)
Листинг программы
uses Crt;
type DataType = integer;
type PTree=^TTree;
TTree = record
Data: DataType;
Left, Right: PTree;
end;
label m1;
var Tree: Ptree;
ch: char;
numb, i, nu: integer;
Function NewElement(X: DataType): PTree; {размещение в куче нового элемента}
Var T: PTree;
Begin
New (T);
T^.Data: =X;
T^.Right: =Nil;
T^.Left: =Nil;
NewElement: =T;
End;
Procedure AddElement(Var R: PTree; N: DataType); {размещение нового элемента в структуре}
Begin
If R< > Nil then begin
If R^.Data< N then begin
If R^.Left=nil then R^.Left: =NewElement(N) else AddElement(R^.Left, N);
end
else begin
If R^.Right=nil then R^.Right: =NewElement(N) else AddElement(R^.Right, N);
end;
end
else begin {дерево не создано, создаем его}
R: =NewElement(N);
end;
End;
Procedure Tab(n: Integer); {отступы, для вывода}
var i: integer;
Begin
for i: =1 to n do write(' ');
End;
Procedure Print(T: PTree; g: integer); {Печать дерева. G-глубина }
Const k=5;
Begin
If T=nil then Writeln ('Дерево пустое') else begin
g: =g+1;
If T^.Right < > nil then
Print (T^.Left, g);
Tab(k*g); Writeln (T^.Data);
If T^.Left < > nil then
Print (T^.Right, g);
g: =g-1;
End;
End;
Function Find(R: PTree; F: DataType): PTree; {Поиск элемента}
Var t: Ptree;
Begin t: =Nil;
If R< > Nil then begin {Если дерево не пустое}
If R^.Data=F then begin {Проверяем значение ключевого поля}
t: =R; {Если нашли нужный элемент, запоминаем его значение}
end
else begin {если не нашли}
t: =Find(R^.Left, F); {пытаемся найти в других ветвях дерева (сначала слева)}
If t=Nil then t: =Find(R^.Right, F); {Потом справа, если слева ничего не нашли}
end;
end;
Find: =t; {Результат функции - значение временной переменной t}
End;
function findwithparent(root: ptree; key: integer; var p, parent: ptree): Boolean; {находим вершину с род.}
begin
parent: =nil;
p: =root;
while p< > nil do begin
if key=p^.data then begin { узел с таким ключом есть }
findwithparent: =true;
exit;
end;
parent: =p; {запомнить указатель на предка}
if key> p^.data then
p: = p ^. left {спуститься влево}
else p: = p ^. right; {спуститься вправо}
end;
findwithparent: =false;
end;
procedure DeleteFromBinarySearchTree (Sought: DataType; {удаление элемента из дерева}
var B: Ptree);
var
Delend, p, parent: Ptree;
function DeleteLargest (var Site: Ptree): Datatype; {удаление самого бол. Элемента}
var
Delend: Ptree;
begin
if Site^.Right=nil then begin
DeleteLargest: = Site^.Data;
Delend: = Site;
Site: = Site^.Left;
Dispose (Delend)
end
else
DeleteLargest: = DeleteLargest (Site^.Right)
end;
begin
if B < > nil then begin
if Sought > B^.Data then
DeleteFromBinarySearchTree (Sought, B^.Left)
else if B^.Data > Sought then
DeleteFromBinarySearchTree (Sought, B^.Right)
else
begin { мы нашли элемент, который надо удалить }
if (b^.left=nil) and (b^.right=nil) then {нет потомков}
begin
if (b^.data=tree^.data) then tree: =nil {если удаляемый элемент - корень}
else
begin
findwithparent(tree, b^.data, p, parent);
if parent^.left^.data=b^.data then parent^.left: =nil
else parent^.right: =nil;
dispose(p);
end;
end
else if B^.Left=nil then begin {если только левое поддерево пустое}
Delend: = B;
B: = B^.Right;
Dispose (Delend)
end
else if B^.Right=nil then begin {если только правое поддерево пустое}
Delend: = B;
B: = B^.Left;
Dispose (Delend)
end
else
B^.Data: = DeleteLargest (B^.Left) {если в обоих поддеревьях что-то есть}
end
end
end;
procedure InOrder(root: Ptree); {Cимметричный обход}
begin
if root< > nil then
begin
InOrder(root^.left);
Write(root^.data, ' ');
InOrder(root^.right);
end;
end;
procedure PreOrder(root: Ptree); {Прямой обход}
begin
if root< > nil then
begin
write(root^.data, ' ');
preorder(root^.left);
preorder(root^.right);
end;
end;
procedure PostOrder(root: PTree); {Обратный обход}
begin
if root< > nil then
begin
postorder(root^.left);
postorder(root^.right);
Write(root^.data, ' ');
end;
end;
procedure DeleteTheTree(root: Ptree); {удалить всё дерево}
begin
if root< > nil then
begin
DeleteTheTree(root^.left);
DeleteTheTree(root^.right);
DeleteFromBinarySearchTree(root^.data, root);
end;
end;
begin {главная программа}
clrscr;
m1: Tree: = nil;
Writeln('Случайное заполнение узлов? Y/N ');
ch: = ReadKey;
ch: = UpCase(ch);
if ch='Y' then {если заполнять случайно}
begin
randomize;
writeln('Сколько узлов должно быть? ');
readln(numb);
for i: =1 to numb do
begin
nu: =random(100);
AddElement(tree, nu);
end;
end
else
begin
writeln('Введите свои числа. -1 - конец ввода');
while true do
begin
readln(nu);
if nu< > -1 then AddElement(tree, nu)
else break;
end;
end;
Print(tree, height(tree));
writeln('');
while (true) do
begin
writeln('');
writeln('Что сделать? ');
writeln('Поиск элемента - 1');
writeln('Удаление элемента - 2');
writeln('Прямой обход - 3');
writeln('Симметричный обход - 4');
writeln('Обратный обход - 5');
writeln('Удалить дерево - 6');
writeln('Создать новое - 7');
writeln('Выход - q');
readln(ch);
ch: =upcase(ch);
if (ch='1') then
begin
writeln('Введите число: ');
readln(nu);
if (Find(tree, nu)=nil) then writeln('Нет такого элемента')
else writeln('Такой элемент есть');
end
else if (ch='3') then
PreOrder(tree)
else if (ch='4') then
InOrder(tree)
else if ch='5' then
PostOrder(tree)
else if ch='2' then
begin
writeln('Введите число: ');
readln(nu);
{ deletenode(tree, nu); }
DeleteFromBinarySearchTree(nu, tree);
Print(tree, height(tree));
end
else if ch='6' then
begin
DeleteTheTree(tree);
Print(tree, height(tree));
end
else if ch='7' then
begin
DeleteTheTree(tree);
goto m1;
end
else exit;
end;
end.
