Студопедия

Главная страница Случайная страница

КАТЕГОРИИ:

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






Приложение А. 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.


mylektsii.ru - Мои Лекции - 2015-2018 год. (0.023 сек.)Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав Пожаловаться на материал