Поиск в ширину на графах

{вывод (просмотр) информации вершины}

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);

Если Вам нужна помощь с академической работой (курсовая, контрольная, диплом, реферат и т.д.), обратитесь к нашим специалистам. Более 90000 специалистов готовы Вам помочь.
Бесплатные корректировки и доработки. Бесплатная оценка стоимости работы.

Поможем написать работу на аналогичную тему

Получить выполненную работу или консультацию специалиста по вашему учебному проекту
Нужна помощь в написании работы?
Мы - биржа профессиональных авторов (преподавателей и доцентов вузов). Пишем статьи РИНЦ, ВАК, Scopus. Помогаем в публикации. Правки вносим бесплатно.

Похожие рефераты: