Помогите спецы с данной работой!
Препод просто кинул мне её и сказа НЕПРАВИЛЬНО, ПЕРЕДЕЛАТЬ ПОЛНОСТЮ
Лабораторная работа № 5 Поиск компонент связности графа
Граф задан его матрицей смежности. Требуется определить количество компонент связности этого графа . При этом должны быть конкретно перечислены вершины, входящие в каждую компоненту связности.
Выбор алгоритма поиска компонент связности – произвольный. Например, приветствуется использование одного из видов обхода (поиск в глубину или поиск в ширину по материалам п. 3.4.3).
Пользователю должна быть предоставлена возможность редактировать исходную матрицу, т.е. изменять исходный граф без выхода из программы. Предусмотреть также возможность изменения количества вершин.
При выполнении работы разрешается (даже рекомендуется!) использовать матрицу бинарных отношений из лабораторной работы №2.
Вход программы: число вершин графа и матрица смежности.
Выход: разбиение множества вершин на подмножества, соответствующие компонентам связности.
Дополнительно:
Заданный граф рассматривать как ориентированный. Выполнять поиск компонент сильной связности.
{
Поиск компонент связности графа
Граф задан его матрицей смежности.
Требуется определить количество компонент связности
этого графа. При этом должны быть конкретно перечислены
вершины, входящие в каждую компоненту связности.
}
program laba5;
uses crt;
const nn=50;
var
mat:array[1..nn,1..nn] of 0..1; {матрица смежности}
vec:array[1..nn] of byte;
n:integer; {количество вершин}
i,j,t,nk,ns:integer;
{ввод матрицы смежности}
procedure vvodMatr;
var i,j,t:integer;
begin
fillchar(mat,sizeof(mat),0);
write('Введите количество вершин графа: ');
readln(n);
for i:=1 to n do
for j:=i+1 to n do
begin
write('Связаны ли вершины ',i,' и ',j,' (1-да, 0-нет) > ');
readln(t);
mat[i,j]:=t;
mat[j,i]:=t;
end
end;
{вывод на экран матрицы}
procedure printMatr;
var i,j:integer;
begin
writeln('Матрица смежности');
for i:=1 to n do
begin
for j:=1 to n do
write(mat[i,j]);
writeln;
end;
end;
procedure redaktMatr;
var i,j:integer;
begin
repeat
clrscr;
writeln('Матрица смежности');
printMatr;
write('Введите номер строки >');
readln(i);
write('Введите номер столбца >');
readln(j);
if(i<=n)and(j<=n)and(i<>j)then
case mat[i,j] of
1:begin mat[i,j]:=0;mat[j,i]:=0;end;
0:begin mat[i,j]:=1;mat[j,i]:=1;end;
end;
clrscr;
writeln('Матрица смежности');
printMatr;
writeln('Редактировать матрицу смежности ещё? 1-да,0-нет');
readln(i);
until(i=0);
end;
procedure dfs(v,nom:byte);
var i:integer;
begin
vec[v]:=nom;
for i:=1 to n do
if(mat[v,i]=1)and(vec=0) then dfs(i,nom);
end;
function prov:integer; {функция проверяющая - есть ли непомеченные вершины}
var i,t:integer;
begin
t:=0;
for i:=1 to n do
if vec=0 then
begin
t:=i;
break;
end;
prov:=t;
end;
begin
clrscr;
vvodMatr;
fillchar(vec,sizeof(vec),0);
repeat
ns:=0; {количество компонент связности}
nk:=1;
clrscr;
printMatr;
writeln('Компоненты связности и вершины, входящие в них: ');
repeat
inc(ns);
dfs(nk,ns);
write(ns,'. ');
for i:=1 to n do
if vec=ns then
write(i,' ');
writeln;
nk:=prov;
until (nk=0);
writeln('Количество компонент связности: ',ns);
writeln('Редактировать матрицу смежности? 1-да,0-нет');
readln(t);
if (t = 1) then
redaktMatr;
until(t=0);
end.