Операции над бинарным деревом AVL
Язык: Borland Pascal 7.0
Курс: Алгоритмы и структуры данных
В данной статье рассматривается:
- Поиск в дереве заданного узла без вставки
- Поиск в дереве заданного узла со вставкой
- Подсчёт количества узлов в дереве
- Подсчёт количества концевых узлов в дереве
- Удаление узла из дерева
- Повороты LR LL
- Вывод верева на экран
- Включение нового узла
- Удаление всего дерева
- Поиск узла по ключу
Program Derevo_AVL; { Make 11.01.1999 }
Uses { All rights reserved }
Crt;
Type
Typel = integer;
Ref = ^z;
z = record
inf : Typel;
bal : -2..2;
left, right : Ref
end;
Var
key : Char;
stop : Boolean;
h : Integer;
root,p : Ref;
s : Typel;
ok : Boolean;
{--------------------------------------------------------------------------}
Procedure Ramka;
var
i : integer;
begin
TextColor(13);
For i:=1 to 47 do
begin
Gotoxy(15+i,9);
Write('Н');
Gotoxy(15+i,18);
Write('Н')
end;
For i:=1 to 8 do
begin
Gotoxy(16,9+i);
Write('є');
Gotoxy(62,9+i);
Write('є')
end;
Gotoxy(62,9);
Write('>');
Gotoxy(16,9);
Write('Й');
Gotoxy(62,18);
Write('_');
Gotoxy(16,18);
Write('И')
end;
{--------------------------------------------------------------------------}
{ Поиск в дереве заданного узла без вставки }
Procedure Poisk(root:ref);
begin
if root <> nil
then
begin
if root^.inf = s
then
ok:=true;
poisk(root^.right);
poisk(root^.left)
end
end;
{--------------------------------------------------------------------------}
Procedure Print2 (root:ref; h:integer; s: typel);
var
i: integer;
begin
if root<>nil
then
begin
print2(root^.right,h+2,s);
for i:=1 to h do
write(' ');
if root^.inf = s
then
textcolor(14)
else
textcolor(15);
writeln(root^.inf);
print2(root^.left,h+2,s);
end
end;
Procedure Printing;
begin
TextColor(1);
ClrScr;
TextColor(15);
if root = nil
then
begin
Writeln('Дерево не задано...');
ReadKey;
TextColor(1);
ClrScr;
Exit
end;
Write('Что ищем (?) : ');
Readln(s);
Ok:=false;
poisk(root);
Print2(root,0,s);
TextColor(15);
if not ok
then
writeln('Узел ''',s,''' не найден...')
else
writeln('Узел ''',s,''' найден...');
ReadKey;
TextColor(1);
ClrScr
end;
{--------------------------------------------------------------------------}
{ Поиск в дереве заданного узла со вставкой }
Procedure Poisk2(x:typel;var p: ref; var h : boolean);
var
p1,p2 : ref;
begin
if p = nil
then
begin
new (p);
h := true;
p^.inf := x;
p^.left := nil;
p^.right := nil;
p^.bal := 0
end
else
if x < p^.inf then
begin
Poisk2(x, p^.left, h);
if h
then
if p^.bal = 0
then
p^.bal:=-1
else
if p^.bal = 1
then
begin
p^.bal:=0;
h:=false
end
else
if p^.bal = -1
then
begin
p1 := p^.left;
if p1^.bal = -1
then
begin { LL ПОВОРОТ }
p^.left := p1^.right;
p1^.right := p;
p^.bal := 0;
p1^.bal := 0;
h:=false;
p := p1
end
else
begin { LR ПОВОРОТ }
p2 := p1^.right;
h:=false;
p^.left := p2^.right;
p2^.right := p;
p1^.right:=p2^.left;
p2^.left:=p1;
Case p2^.bal of
1:begin
p1^.bal := -1;
p^.bal:=0
end;
-1:begin
p1^.bal := 0;
p^.bal:=1
end;
0:begin
dec(p1^.bal,1);
inc(p^.bal,1)
end;
end;
p := p2;
p^.bal:=0
end
end;
end
else
if x > p^.inf
then
begin
Poisk2(x, p^.right, h);
if h
then
if p^.bal = 0
then
p^.bal:=1
else
if p^.bal = -1
then
begin
p^.bal:=0;
h:=false
end
else
if p^.bal = 1
then
begin
p1 := p^.right;
if p1^.bal = 1
then
begin { RR ПОВОРОТ }
p^.right := p1^.left;
p1^.left := p;
p^.bal := 0;
p1^.bal := 0;
h:=false;
p := p1
end
else
begin { RL ПОВОРОТ }
p2 := p1^.left;
h:=false;
p^.right := p2^.left;
p2^.left := p;
p1^.left:=p2^.right;
p2^.right:=p1;
Case p2^.bal of
1:begin
p1^.bal := 0;
p^.bal:=-1
end;
-1:begin
p1^.bal := 1;
p^.bal:=0
end;
0:begin
inc(p1^.bal,1);
dec(p^.bal,1)
end;
end;
p := p2;
p^.bal:=0
end
end;
end
else
begin
h := False;
ok:=true
{ Найден узел с заданными значениями ключа }
end
end;
{--------------------------------------------------------------------------}
{ Подсчёт количества узлов в дереве }
Function Count(p:ref):integer;
begin
if p = nil
then
count:=0
else
count:=1+count(p^.left)+count(p^.right)
end;
{--------------------------------------------------------------------------}
{ Подсчёт количества концевых узлов в дереве }
Function Count2(p:ref):integer;
begin
if p <> nil
then
begin
if p^.left = p^.right
then
count2:=1
else
count2:=count2(p^.left)+count2(p^.right)
end
else
count2:=0
end;
{--------------------------------------------------------------------------}
{ Удаление узла из дерева }
Procedure RebuildL(var root : ref; var h : Boolean);
Procedure LR (var root:ref; var h:boolean);
var
p, q, r : ref;
begin
h := False;
p := root;
q := root^.left;
r := q^.right;
root := r;
q^.right := r^.left;
p^.left := r^.right;
r^.left := q;
r^.right := p;
Case r^.bal of
1 : begin
p^.bal := 0;
q^.bal := -1
end;
-1: begin
p^.bal := 1;
q^.bal := 0
end;
end;
r^.bal := 0
end;
Procedure LL (var root : ref; var h : Boolean);
var
p, q : ref;
begin
h := False;
p := root;
q := root^.left;
p^.left := q^.right;
q^.right := p;
root := q;
q^.bal := 0;
p^.bal := 0
end;
begin
If root^.left^.bal = -1
then
LL (root, h);
If root^.left^.bal = 1
then
LR (root, h)
end;
Procedure RebuildR (var root : ref; var h : Boolean);
Procedure RR (var root : ref; var h : Boolean);
var
p, q : ref;
begin
h := False;
p := root;
q := root^.right;
p^.right := q^.left;
q^.left := p;
root := q;
q^.bal := 0;
p^.bal := 0
end;
Procedure RL (var root : ref; var h : Boolean);
var
p, q, r : ref;
begin
h := False;
p := root;
q := root^.right;
r := q^.left;
root := r;
q^.left := r^.right;
p^.right := r^.left;
r^.right := q;
r^.left := p;
Case r^.bal of
1 : begin
p^.bal := -1;
q^.bal := 0
end;
-1: begin
q^.bal := 1;
p^.bal := 0
end
end
end;
begin
If root^.right^.bal = -1
then
RL (root, h);
If root^.right^.bal = 1
then
RR (root, h);
end;
Procedure Delete (var root : ref; x : integer);
var
q : ref;
h : Boolean;
Procedure Del2 (var r : ref);
begin
If r^.right <> nil
then
begin
Del2 (r^.right);
r^.bal := r^.bal - 1;
h := True;
If r^.bal = -2
then
begin
r^.bal:=-1;
RebuildL (r, h)
end
end
else
begin
q^.inf := r^.inf;
q := r;
r := r^.left
end
end;
begin
If root <> nil then
If x < root^.inf then
begin
Delete (root^.left, x);
Case root^.bal of
1: RebuildR (root, h);
-1: begin
root^.bal := 0;
h := True
end;
0: begin
root^.bal := 1;
h := False
end
end
end
else
If x > root^.inf
then
begin
Delete (root^.right, x);
Case root^.bal of
1: begin
root^.bal := 0;
h := False
end;
0: begin
root^.bal := -1;
h := True
end;
-1: RebuildL (root, h)
end
end
else
begin
q := root;
If root^.left = nil
then
root := root^.right
else
If root^.right = nil
then
root := root^.left
else
Del2 (root^.left);
Dispose (q)
end
end;
Procedure DelPunkt;
begin
TextColor(1);
ClrScr;
TextColor(15);
Write('Введите ключ : ');
Readln(s);
ok:=false;
Poisk(root);
If ok
then
begin
ok:=false;
Delete(root,s);
Writeln('Узел удалён...');
if Count(root) = 0
then
Writeln('Дерево уничтожено.')
end
else
begin
Writeln('Узел не удалён, т.к. его в дереве нет !!!');
if Count(root) = 0
then
Writeln('Да и самого дерева тоже нет.')
end;
ReadKey;
TextColor(1);
ClrScr
end;
{--------------------------------------------------------------------------}
Procedure PrintTree_txt( root : ref; h: integer);
var
i: integer;
begin
if root<>nil
then
begin
printtree_txt(root^.right,h+2);
for i:=1 to h do
write(' ');
writeln(root^.inf);
printtree_txt(root^.left,h+2);
end
end;
{--------------------------------------------------------------------------}
Procedure PrintPunkt;
begin
textcolor(1);
clrscr;
textcolor(11);
if root = nil
then
writeln('Дерево не задано...')
else
begin
printtree_txt(root,0);
writeln('Количество узлов в дереве : ',Count(root));
writeln('Количество концевых узлов в дереве (Function of '+
'10.01.1999) : ',Count2(root))
end;
readkey;
textcolor(1);
textbackground(1);
clrscr
end;
{--------------------------------------------------------------------------}
Procedure DelPunkt2;
var
i : integer;
begin
i:=count(root);
while root <> nil do
delete(root,root^.inf);
root:=nil;
if not stop
then
begin
textcolor(1);
clrscr;
textcolor(10);
if i = 0
then
writeln('Дерево не задано...')
else
writeln('Дерево уничтожено...');
readkey;
textcolor(1);
textbackground(1);
clrscr
end
end;
{--------------------------------------------------------------------------}
Procedure Insert_Punkt;
var
i,x : integer;
s,s1 : integer;
h : boolean;
begin
TextColor(1);
ClrScr;
TextColor(15);
Gotoxy(28,10);
Write('1-Вставка по ключу.');
Gotoxy(28,11);
Write('2-Вставка по RANDOM.');
key:=ReadKey;
TextColor(1);
ClrScr;
TextColor(15);
If key = '1'
then
begin
Write('Введите ключ : ');
Readln(s);
ok:=false;
h:=false;
Poisk2(s,root,h);
If ok
then
Writeln('Узел с данным ключём уже существует...')
else
Writeln('Ok...');
ReadKey;
TextColor(1);
ClrScr;
Exit
end;
If key = '2'
then
begin
Write('Сколько вставляем узлов: ');
Readln(x);
s1:=Count(root);
i:=0;
While i < x do
begin
ok:=true;
while ok do
begin
s:=Random(x+s1+10);
ok:=false;
Poisk2(s,root,h);
if not ok
then
inc(i)
end;
end;
Writeln('Ok...');
ReadKey
end;
TextColor(1);
ClrScr
end;
{--------------------------------------------------------------------------}
Begin
{ new(root);}
root:=nil;
TextColor(1);
TextBackground(1);
ClrScr;
stop:=false;
While not stop do
begin
Ramka;
TextColor(11);
Gotoxy(17,2);
Writeln('Программа студента гр. ПА-97 Шарова Евгения');
Gotoxy(30,23);
Writeln('All rights reserved.');
TextColor(10);
Gotoxy(24,7);
Writeln('Операции над бинарным деревом.');
TextColor(15);
Gotoxy(20,11);
Write('Вывод верева на экран.................1');
Gotoxy(20,12);
Write('Включение нового узла.................2');
Gotoxy(20,13);
Write('Удаление узла.........................3');
Gotoxy(20,14);
Write('Удаление всего дерева.................4');
Gotoxy(20,15);
Write('Поиск узла по ключу...................5');
Gotoxy(20,16);
Write('Выход в ДОС...........................6');
key:=ReadKey;
Case key of
'1' : PrintPunkt;
'2' : Insert_Punkt;
'3' : DelPunkt;
'4' : DelPunkt2;
'5' : Printing;
'6' : stop:= not stop
else
begin
Sound(160);
Delay(17);
NoSound
end
end
end;
DelPunkt2;
TextMode(3)
End.
JavaScript — это язык веб-программирования, работающий на стороне клиента, позволяющий автоматизировать какую-либо деятельность на странице сайта, не нагружая сервер. Вся нагрузка лежит на компьютере пользователя. В нем можно создавать функции, а также использовать базовые алгоритмы, состоящие из следования-ветвления-цикла. Чаще всего программный код на языке JavaScript обрабатывается обычными веб-браузерами. |
Интересные материалы на сайте:
|
|