Операции над бинарным деревом AVL
Язык: Borland Pascal 7.0
Курс: Линейные динамические структуры данных
В данной статье рассматривается:
- Задать граф
- Просмотреть граф
- Выполнить топологическую сортировку
- Графическое описание массива А
- Поиск изолированных вершин
Program Topolog_Sortirovka; { Make 06.11.1998 }
Uses { All rights reserved }
Crt;
Const
max = 26; { КОЛИЧЕСТВО ЭЛЕМЕНТОВ ГРАФА }
Type
T_elem = Char;
ref = ^elem;
elem = record
n : 0..max;
next : ref
end;
t = array [1..max+1] of record
name : t_elem;
data : elem
end;
Var
a,b : t;
key : char;
stop,sig : Boolean;
cur,q : ref;
c : integer;
count : integer;
cp : array [1..4] of byte;
{--------------------------------------------------------------------------}
procedure ramka;
var
i : integer;
begin
textcolor(13);
for i:=1 to 47 do
begin
gotoxy(15+i,9);
write('Н');
gotoxy(15+i,16);
write('Н')
end;
for i:=1 to 6 do
begin
gotoxy(16,9+i);
write('є');
gotoxy(62,9+i);
write('є')
end;
gotoxy(62,9);
write('>');
gotoxy(16,9);
write('Й');
gotoxy(62,16);
write('_');
gotoxy(16,16);
write('И')
end;
{--------------------------------------------------------------------------}
procedure clear;
var
i : integer;
begin
for i:=1 to max+1 do
begin
cur:=a[i].data.next;
if cur <> nil
then
begin
q:=cur;
cur:=cur^.next;
while cur <> nil do
begin
q^.next:=cur^.next;
dispose(cur);
cur:=q^.next
end
end
end;
for i:=1 to max+1 do
begin
cur:=b[i].data.next;
if cur <> nil
then
begin
q:=cur;
cur:=cur^.next;
while cur <> nil do
begin
q^.next:=cur^.next;
dispose(cur);
cur:=q^.next
end
end
end;
end;
{--------------------------------------------------------------------------}
procedure Konstructor_Graph;
var
i,j,k : integer;
name1,name2 : string[10];
stop2 : boolean;
key : char;
begin
textcolor(1);
clrscr;
textcolor(15);
clear;
sig:=false;
for i:=1 to max+1 do
begin
a[i].name:=upcase(chr(i+96));
a[i].data.next:=nil;
a[i].data.n:=0
end;
stop2:=false;
writeln('Сколько вершин в графе ?');
write('[N] : ');
readln(count);
if (count > max) or (count<1)
then
begin
writeln('Ошибка ! В графе должно быть не более ',max,
' и не менее одной вершины.');
readkey;
textcolor(1);
cp[2]:=7;
cp[3]:=7;
sig:=false;
clrscr;
exit
end;
if count > 1
then
begin
writeln('Введите данные для графа ( вершины графа : ',
a[1].name,'..',a[count].name,' ).');
writeln('ЕNTER - завершение ввода.')
end;
if count = 1
then
stop2:=true;
while not stop2 do
begin
key:=readkey;
if key = #13
then
begin
stop2:=true;
name1:=''
end
else
name1:=UpCase(key);
if not stop2
then
write(name1,' -',#26,' ');
if not stop2
then
begin
key:=readkey;
if key = #13
then
begin
stop2:=true;
name2:=''
end
else
name2:=UpCase(key);
end ;
if (name1<>'') or (name2<>'')
then
begin
if not stop2
then
writeln(name2);
for i:=1 to max do
if a[i].name = name2
then
for j:=1 to max do
if a[j].name = name1
then
begin
cur:=a[j].data.next;
if cur <> nil
then
begin
while cur <> nil do
begin
q:=cur;
cur:=cur^.next
end;
new(cur);
q^.next:=cur
end
else
begin
new(cur);
a[j].data.next:=cur
end;
cur^.n:=i;
cur^.next:=nil
end
end
else
stop2:=not stop2
end;
for i:=1 to count do
begin
k:=0;
for j:=1 to max do
begin
cur:=a[j].data.next;
while cur <> nil do
begin
if cur^.n = i
then
k:=k+1;
cur:=cur^.next
end
end;
a[i].data.n:=k
end;
j:=0;
for i:=1 to count do
if (a[i].data.n = 0) and (a[i].data.next = nil)
then
j:=j+1;
if j = 0
then
write('Изолированных вершин нет.')
else
begin
write('Изолированные вершины : ');
for i:=1 to count do
if (a[i].data.n = 0) and (a[i].data.next = nil)
then
write(a[i].name,' ')
end;
b:=a;
sig:=true;
cp[2]:=15;
cp[3]:=15;
readkey;
textcolor(1);
clrscr
end;
{--------------------------------------------------------------------------}
procedure Go_sort;
var
r,i,j,k,l : integer;
ok : boolean;
begin
textcolor(1);
clrscr;
textcolor(15);
i:=1;
r:=0;
{-------------------- Основной цикл ----------------------}
while i <> 0 do
begin
i:=0;
for j:=1 to count do
if a[j].data.n = 0
then
begin
k:=0;
cur:=a[max+1].data.next;
while cur <> nil do
begin
if cur^.n = j
then
k:=k+1;
cur:=cur^.next
end;
if k = 0
then
begin
r:=r+1;
i:=i+1;
cur:=a[max+1].data.next;
if cur = nil
then
begin
new(a[max+1].data.next);
cur:=a[max+1].data.next
end
else
begin
while cur <> nil do
begin
q:=cur;
cur:=cur^.next
end;
new(cur);
q^.next:=cur
end;
cur^.next:=nil;
cur^.n:=j;
cur:=a[j].data.next;
while cur <> nil do
begin
if a[cur^.n].data.n > 0
then
dec(a[cur^.n].data.n);
cur:=cur^.next
end
end
end
end;
{-------------- Завершение основного цикла ---------------}
cur:=a[max+1].data.next;
while cur <> nil do
begin
write(a[cur^.n].name,' ');
cur:=cur^.next
end;
writeln;
textcolor(11);
if r <> count
then
ok:=false
else
ok:=true;
if not ok
then
write('Полное решение не существует...')
else
write('Полное решение существует...');
a:=b;
readkey;
textcolor(1);
clrscr
end;
{--------------------------------------------------------------------------}
procedure Look_to_Graph;
var
i,j : integer;
begin
textcolor(1);
clrscr;
textcolor(11);
b:=a;
writeln(' ':17,'Графическое описание массива А :');
writeln;
textcolor(15);
for i:=1 to count do
begin
write('A[',i:2,'] : ',a[i].name:3,' | ',a[i].data.n);
cur:=a[i].data.next;
while cur<>nil do
begin
write(' -',#26,' ',a[cur^.n].name);
cur:=cur^.next
end;
writeln(' -',#26,' nil')
end;
for i:=1 to count do
if (a[i].data.n = 0) and (a[i].data.next = nil)
then
j:=j+1;
if j = 0
then
write('Изолированных вершин нет.')
else
begin
write('Изолированные вершины : ');
for i:=1 to count do
if (a[i].data.n = 0) and (a[i].data.next = nil)
then
write(a[i].name,' ')
end;
a:=b;
readkey;
textcolor(1);
clrscr
end;
{--------------------------------------------------------------------------}
BEGIN
textcolor(1);
textbackground(1);
clrscr;
cp[1]:=15;
cp[2]:=7;
cp[3]:=7;
cp[4]:=15;
stop:=false;
sig:=false;
while not stop do
begin
textcolor(11);
gotoxy(17,2);
writeln('Программа студента гр. ПА-97 Шарова Евгения');
gotoxy(30,23);
writeln('All rights reserved.');
textcolor(10);
gotoxy(20,7);
writeln('Линейные динамические структуры данных.');
writeln(' ':25,'Топологическая сортировка.');
ramka;
textcolor(15);
gotoxy(20,11);
textcolor(cp[1]);
write('Задать граф...........................1');
gotoxy(20,12);
textcolor(cp[2]);
write('Просмотреть граф......................2');
gotoxy(20,13);
textcolor(cp[3]);
write('Выполнить топологическую сортировку...3');
gotoxy(20,14);
textcolor(cp[4]);
write('Выход в ДОС...........................4');
key:=readkey;
case key of
'1' : Konstructor_Graph;
'2' : if sig
then
Look_to_Graph;
'3' : if sig
then
Go_sort;
'4' : stop:= not stop;
else
begin
Sound(35+random(160));
Delay(37);
NoSound
end
end
end;
clear;
textmode(3)
END.
Delphi — это объектно-ориентированный язык программирования со строгой типизацией переменных. Он используется в основном для написания прикладных, пользовательских программ. Простота использования позволяет рекомендовать его в качестве языка для начального обучения программированию. Хотя, если смотреть на перспективу, работодатели мало интересуются работниками, программирующими на Delphi. |
Интересные материалы на сайте:
|
|