Поиск в ширину на графах
if prosm then begin
if wherex>=79 then writeln;
write(ver[p],' ');
end;
o9:=oo;
for u:=1 to o9 do {u изменяется в диапазоне размера очереди}
begin
rebro:=false;{связи между ver[v] и ver[u] нет}
{указатель на начало списка связей v-й вершины}
m[v]:=lst[v];
while m[v]<>nil do
begin {поиск значения ver[u] в списке связей v-й вершины}
if m[v]^.inf=ver[u] then begin
{ребро есть} rebro:=true;
break;
end;
m[v]:=m[v]^.next; {ребра пока нет...}
end;
{если связь не установлена, поищем связь с ver[v] в списке u-й вершины, т.е. наоборот...}
if not(rebro) then
begin
m[u]:=lst[u];{указатель на начало списка связей u-й вершины}
while m[u]<>nil do
begin
if m[u]^.inf=ver[v] then begin
rebro:=true;
break;
end;
m[u]:=m[u]^.next;
end;
end;
{если связь все таки есть и u-я вершина еще не рассмотрена...}
if rebro and Nw[u] then
begin
inc(oo); {вставка u в начало очереди}
for op:=oo downto 2 do ocher[op]:=ocher[op-1];
ocher[1]:=u;
Nw[u]:=False;{флаг на вершину с индексом u}
end;
end;
end;
end;
{------------------------------------------------------
***Процедура просмотра графа***}
Procedure Write_S(key: longint; prosm: boolean;
var find: boolean; var schet: word);
begin
{инициализация признаков просмотра вершин}
for i:=1 to raz do Nw[i]:=true;
for i:=1 to raz do
{если из raz вершин i-ая не использована, то смотреть граф с i-ой вершины}
if Nw[i] and not(find) then WS(i,find,schet);
end;
{------------------------------------------------------
***Процедура сортировки вершин по неубыванию***}
procedure Sort;
begin
for l:=1 to raz-1 do
for j:=1 to raz-l do
if ver[j]>ver[j+1] then
begin
exch:=ver[j];
el:=lst[j];
em:=m[j];
ver[j]:=ver[j+1];
lst[j]:=lst[j+1];
m[j]:=m[j+1];
ver[j+1]:=exch;
lst[j+1]:=el;
m[j+1]:=em;
end;
end;
{=====================================================}
begin
while menu<>'4' do
begin
textmode(1);
textbackground(blue);
clrscr;
textcolor(red);
gotoxy(16,3); writeln('Г Р А Ф Ы');
textcolor(white);gotoxy(5,5);
writeln('* Исследование поиска в ширину *');
textcolor(black); gotoxy(7,22);
writeln('Created by Andrew Spikhailo');
gotoxy(15,24); write('ARMAVIR 2001');
textcolor(white);
gotoxy(7,10); write('┌───────────MENU───────────╖');
gotoxy(7,11); write('│');textcolor(green);
write('1 Создание графа '); textcolor(white);write('║');
gotoxy(7,12); write('│');textcolor(green);
write('2 Просмотр графа '); textcolor(white);write('║');
gotoxy(7,13); write('│');textcolor(green);
write('3 Поиск элемента графа '); textcolor(white);write('║');
gotoxy(7,14); write('│');textcolor(green);
write('4 Выход '); textcolor(white);write('║');
gotoxy(7,15); write('│');textcolor(white+128);
write('Выберите номер пункта меню'); textcolor(white);write('║');
gotoxy(7,16); write('╘══════════════════════════╝');
menu:=readkey;
case menu of
'1': begin
{освобождение памяти, если она была занята}
textmode(2);
textbackground(blue);
clrscr; textcolor(lightgreen);
if mem then release(size);
repeat
clrscr;
write('Число вершин графа: ');
writeln('(1) - десять');
gotoxy(21,wherey);
writeln('(2) - сто');
gotoxy(21,wherey);
writeln('(3) - четыреста');
gotoxy(21,wherey);
write('(4) - другое...');
raz:=0;
repeat
craz:=readkey;
case craz of
'1': raz:=10;
'2': raz:=100;
'3': raz:=400;
'4': begin
write(' ___');
gotoxy(wherex-3,wherey);
read(raz);
if (raz<=0) or (raz>400) then begin
raz:=0;
gotoxy(38,wherey-1);
write('ERROR...');
delay(1000);
end;
end;
end;
until (craz='1') or (craz='2') or (craz='3') or (craz='4');
clrscr;
until raz>0;
writeln;
write('вывод списка инцидентности графа: ');
writeln('0 - запретить');
gotoxy(35,wherey);