for j:=1 to raz do begin

spro:=true;

if j=raz then goto Er;

if j=i then inc(j);

n:=nil;

n:=lst[j];

if lst[j]<>nil then

repeat

if n^.inf=ver[i] then spro:=false;

n:=n^.next;

until (n=nil) or (not(spro));

if (round(random)=1) and spro then

begin

new(m[i]);

inc(kolvo);

m[i]^.inf:=ver[j];

m[i]^.next:=lst[i];

lst[i]:=m[i];

end;

Er:

end;

end;

writeln;

if mgsi then {ВЫВОД СВЯЗЕЙ ВЕРШИН}

for i:=1 to raz do {}

begin {}

write(ver[i],'-'); {}

m[i]:=lst[i]; {}

if m[i]<>nil then {}

repeat {}

write(m[i]^.inf,'═'); {}

m[i]:=m[i]^.next; {}

until m[i]=nil; {}

writeln(''); writeln; {}

end; {}

writeln('КОЛ-ВО РЕБЕР СОЗДАННОГО ГРАФА: ',kolvo);

end;

{------------------------------------------------------

***Процедура просмотра графа с v-той вершины методом поиска в ширину***}

Procedure WS(v:word; var find: boolean;

var schet: word);

var {v - пор. номер вершины графа}

ik,oo,o9,o3,op: integer;

rebro: boolean;

begin {оо - размер очереди в данном цикле}

ocher[1]:=v; oo:=1; {вставка текущего индекса вершины в начало очереди}

Nw[v]:=False; {флаг на вершину текущего индекса}

while oo>0 do begin {пока есть очередь .}

p:=ocher[1];{удаление 1-го элемента из очереди и присваивание его p}

for op:=1 to oo-1 do ocher[op]:=ocher[op+1]; ocher[oo]:=0;

dec(oo);

inc(schet); {счетчик сравнений}

if not(prosm) and (ver[p]=key) then {if ver[p]=key .}

begin

find:=true;

exit; {поиск окончен}

end;

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

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

write('1 - разрешить');

mg:=readkey;

if mg='1' then mgsi:=true

else mgsi:=false;

clrscr;

mark(size);

Make_Graph(mgsi);

mem:=true;{теперь память можно освобождать}

sor:=false; {вершины не отсортированы}

readkey;

end;

'2': begin {Просмотр графа }

textmode(2);

textbackground(blue);

clrscr; textcolor(lightgreen);

gotoxy(32,3); Writeln('Просмотр графа:');

key:=-1;

find:=false;

prosm:=true; schet:=0;

Write_S(key,prosm,find,schet); writeln;

readkey;

end;

'3': begin {Поиск элемента графа}

clrscr; textcolor(lightgreen);

if not(sor) then begin