Программа для построения и анализа графов / Uconnectivity

unit Uconnectivity;

interface

uses ugraph,classes,sysutils,dialogs;

function FindConComponents(g:tgraph): tarrg;
function FindStronglyConComponents(g:tgraph): tarrg;

implementation

uses UType;


//поиск компонент связности (если ориентированный - поиск слабосвязных компонент)
//lb-массив компонент связности,Orgraph-ориентированный ли граф
function FindConComponents(g:tgraph): tarrg;
var
Mark:array of integer; //массив вершин,значение -№ компоненты связности,к-ой принадлежит вершина
i,j:integer;
//gt:tgraph; //компонента связности (из вершин и ребер)
gp:tgraph;
count:integer;//число компонент смежности
k:integer;//счетчик по вершинам в компоненте
MatrixSmNotOr: array of array of 0..1; //неориентированная м-ца смежности ориентированного графа
MatrixSm:tmatrix;
//m,n:integer;//размеры м-цы смежности

//процедура добавления вершин и смежных с ними ребер в текущую компоненту связности
//x-номер текущей вершины,count-номер текущей компоненты связности
Procedure Component( x,count :Integer);
Var
i,j :Integer;

begin
SetLength(gp.V,length(gp.V)+1);
Mark[x]:=count;
{if length(gp^.V)<x then
SetLength(gp^.V,x+1); }
gp.V[k]:=g.V[x];
inc(k);




for i:=1 to high(g.V) do
//если вершина смежна с текущей
if ((not g.Orgraph) and (MatrixSm.Matrix[x,i] = 1)) or ((g.Orgraph) and (MatrixSmNotOr[x,i] = 1)) then
begin

//поиск в графе g этих смежных ребер и их добавление в подграф gp^
//if (x<i) then //если ребро идет от текущей к смежной
for j := 1 to high(g.E) do
if ((g.E[j].p1 = g.V[x]) and (g.E[j].p2 = g.V[i])){ or ((g.E[j].p1 = g.V[i]) and (g.E[j].p2 = g.V[x]))) } then
begin
SetLength(gp.E,length(gp.E)+1);
gp.E[length(gp.E)-1] := g.E[j];
break;
end;

{gp^.E[length(gp^.E)-1].p1:=g.V[x];
gp^.E[length(gp^.E)-1].p2:=g.V[i];
gp^.E[length(gp^.E)-1].num:=length(gp^.E)-1;}
//если вершина не входит ни в одну компоненту связности
if mark[i] = 0 then
Component(i,count);
end;
end;

begin
ProcessMessages;

{if g.Orgraph then
for i := 1 to length(mark) do
SetLength(high(g.V)+1,high(g.V)+1);
end
else }
setlength(result, 1);
SetLength(mark,high(g.V)+1);
count:=0;


for i := 1 to high(g.V) do
mark[i]:=0;
//new(matrixsm);
//MatrixSm.create(m,n);
g.GetMatrixSm(MatrixSm);
//new(matrixsm);
//MatrixSm.create(m,n);

//построение неориентированной м-цы смежности ориентированного графа
if g.orgraph then
begin
setlength(MatrixSmNotor, length(g.V), length(g.V));
for i := 1 to high(MatrixSmNotor) do
for j := 1 to high(MatrixSmNotor) do
MatrixSmNotOr[i, j]:=0;

for i := 1 to MatrixSm.row do
for j := 1 to MatrixSm.col do
if (MatrixSm.Matrix[i,j]=1) and (i<>j) then
begin
MatrixSmNotOr[i,j]:=1;
MatrixSmNotOr[j,i]:=1;
end;



end;

for i := 1 to high(g.V) do
if mark[i]=0 then
begin
gp:=tgraph.Create;
SetLength(gp.V,1);
SetLength(gp.e,1);
k:=1;
inc(count);
Component(i,count);
gp.comment:='Компонента связности '+inttostr(count);

//gp^:=gt;
setlength(result, length(result)+1);
new(result[high(result)]);
result[high(result)]^:=gp;
// LB.Addobject(gp.comment, Tobject(gp));
end;
g.SearchReachMatrix;

//setlength(MatrixSm.Matrix,0,0);
matrixsm.free;
matrixsm:=nil;
//MatrixSm.destroy;
SetLength(mark,0);
mark:=nil;
end;


//поиск сильносвязных компонент связности в ориентированном графе
//lb-массив компонент связности,Orgraph-ориентированный ли граф
function FindStronglyConComponents(g:tgraph): tarrg;
var
R:TBoolMatrix; //Матрица достижимости (i-ая строка - достижимые вершины для i-ой вершины)
c:array of array of 0..1;//строка - мно-во вершин, образующих сильно связную компоненту
i,j,t:integer;
gp:tgraph;
k:integer;//счетчик по вершинам в компоненте

begin
ProcessMessages;
setlength(result, 1);

//!!!!!!!!!!!!!!!!!!!!!!!!!!генерировать исключение
if not g.Orgraph then
exit;

SetLength(R,high(g.V)+1,high(g.V)+1);



r:=g.SearchReachMatrix;
SetLength(C,high(g.V)+1,high(g.V)+1);
for i := 1 to high(g.V) do
for j := 1 to high(g.V) do
c[i,j]:=0;


//C=R*Q, где Q-транспонированная R
for i := 1 to high(g.V) do
for j := 1 to high(g.V) do
c[i,j] := r[i,j] * r[j,i];
//удаляем одинаковые строки
for i := 1 to high(c)-1 do
begin
j:=i+1;
while j<=high(c) do
begin
if (length(c[i])=length(c[j])) and CompareMem(@c[i][0],@c[j][0],length(c[i])*sizeof(c[1][1])) then
begin
for k := j to high(c)-1 do
c[k]:=c[k+1];
SetLength(c,length(c)-1);
dec(j);
end;
inc(j);
end;

end;

//Формирование подграфа-сильной компоненты связности

for i := 1 to high(c) do //цикл по сильно связным компонентам
begin
gp:=tgraph.create;
SetLength(gp.V,1);
SetLength(gp.e,1);
k:= 1;
for j := 1 to high(c[i]) do
if c[i,j]=1 then
begin
SetLength(gp.V,length(gp.V)+1);
gp.V[k]:=g.V[j];
for t := 1 to high(g.E) do//добавление ребер,принадле-их сильно связной компоненте
if (g.E[t].p1 = g.V[j]) then
// for m := 1 to high(c[i]) do
if c[i,g.Num(g.e[t].p2)] = 1 then
begin
SetLength(gp.E,length(gp.E)+1);
gp.E[length(gp.E)-1] := g.E[t];
//break;
end;
inc(k);
end;
gp.comment:='Сильно связная компонента '+inttostr(i);
setlength(result, length(result)+1);
new(result[high(result)]);
result[high(result)]^:=gp;
end;





SetLength(C,0,0);
C:=nil;
SetLength(R,0,0);
R:=nil;
end;




end.